Projekt zaliczeniowy z przedmiotów Metody data maning i Credit scoring
Marcin Bukowski
02 czerwiec 2023
Cel projektu
W tej części należy wskazać co jest celem projektu oraz wskazać metody za pomocą, których ten cel zostanie osiągnięty. Przykładowe metody to:
- analiza graficzna;
- analiza struktur grupowych (grupowanie);
- reguły asocjacji;
- klasyfikacja przeprowadzona na podstawie klasyfikatora OneRule (1R), k-NN, drzew klasyfikacyjnych, modelu logitowego.
Informacje na temat danych
W tej części projektu należy przedstawić charakterystykę danych, na podstawie których przeprowadzona zostanie analiza. Charakterystyka powinna przedstawić zmienne objaśniajace (20 zmiennych charakteryzujących wnioskodawcę) oraz zmienna objaśnianą (jakość kredytu - przyjmujący dwie wartości “dobry” i “zły”). Informacje na temat poszczególnych zmiennych można znaleźć na następującej stronie. Opis danych może wskazywać na ich kompletność, charakter zmiennych (które są ilościowe, a które jakościowe).
Uwaga !! Poniższy skrypt zawiera funkcję
kbl wykorzystywaną przy renderowaniu. Nie spowoduje ona
wyświetlenie tabeli w consoli RStudio przy zastosowaniu RScript. Z tego
powodu nie należy kopiować linijek kodu rozpoczynających się od funkcji
kbl. Zamiast tego można wykorzystać funkcje znajdujące się
powyżej, które w skrypcie zostały umieszczone w postaci komentarzy
(poprzedzone znakiem #). Po przekopiowaniu do RScript i usunięciu # w
consoli pojawi się wynik w postaci podobnej do tabelki. Można go dalej
edytować np. po przekopiowaniu do excela.
library(knitr)
library(dplyr)
library(ggplot2)
library(cluster)
library(dplyr)
library(kableExtra)
library(sjPlot)
library(arules)
library(arulesViz)
library(OneR)
library(kknn)
library(tree)
library(rpart)
library(rpart.plot)
library(ROCR)
library(radiant.data)
load("C:/Users/mbuko/OneDrive/Dokumenty/credit.RData")
tabela<-as.data.frame.matrix(summary(credit) , row.names = F)
opts <- options(knitr.kable.NA = "")
##tabela[,1-7]
kbl(tabela[,1:7], caption = "**Statsystyki opisowe dla zmiennych 1-7**") %>%
kable_classic_2(full_width = T)| konto_czekowe | czas | historia | cel | kwota | oszczednosci | staz_pracy |
|---|---|---|---|---|---|---|
| < 0 :274 | Min. : 4.0 | brak : 40 | RTV :280 | Min. : 250 | <100 :603 | <1 rok :172 |
| >200 : 63 | 1st Qu.:12.0 | istniejace_spł:530 | sam_nowy:234 | 1st Qu.: 1366 | >1000 : 48 | >7 :253 |
| 0-200:269 | Median :18.0 | krytyczne :293 | meble :181 | Median : 2320 | 100-500 :103 | 1-4 :339 |
| brak :394 | Mean :20.9 | opoznienia : 88 | sam_uzyw:103 | Mean : 3271 | 500-1000: 63 | 4-7 :174 |
| 3rd Qu.:24.0 | wszystkie_spł : 49 | biznes : 97 | 3rd Qu.: 3972 | brak :183 | bezrobotny: 62 | |
| Max. :72.0 | edukacja: 50 | Max. :18424 | ||||
| (Other) : 55 |
#tabela[,8:14]
kbl(tabela[,8:14], caption = "**Statsystyki opisowe dla zmiennych 8-14**") %>%
kable_classic_2(full_width = T)| rata_%doch | plec | poreczyciel | zamieszkanie | zabezpieczenie | wiek | inne_zobow |
|---|---|---|---|---|---|---|
| Min. :1.000 | K:310 | brak:907 | Min. :1.000 | brak :154 | Min. :19.00 | bank :139 |
| 1st Qu.:2.000 | M:690 | tak : 93 | 1st Qu.:2.000 | nieruchomosc :282 | 1st Qu.:27.00 | brak :814 |
| Median :3.000 | Median :3.000 | samochod :332 | Median :33.00 | sklep: 47 | ||
| Mean :2.973 | Mean :2.845 | ubezpieczenie:232 | Mean :35.55 | |||
| 3rd Qu.:4.000 | 3rd Qu.:4.000 | 3rd Qu.:42.00 | ||||
| Max. :4.000 | Max. :4.000 | Max. :75.00 | ||||
#tabela[,15:21]
kbl(tabela[,15:21], caption = "**Statsystyki opisowe dla zmiennych 15-21**") %>%
kable_classic_2(full_width = T)| rodzaj_miesz | l_kredytow | kwalifikacje | l_osob | telefon | obcokrajowiec | jakosc |
|---|---|---|---|---|---|---|
| czynsz :179 | Min. :1.000 | niewykwal_nierez: 22 | Min. :1.000 | brak:596 | nie: 37 | dobry:700 |
| wlasne :713 | 1st Qu.:1.000 | niewykwal_rez :200 | 1st Qu.:1.000 | tak :404 | tak:963 | zly :300 |
| za_darmo:108 | Median :1.000 | wykwalifikowany :630 | Median :1.000 | |||
| Mean :1.407 | wysokie_kwal :148 | Mean :1.155 | ||||
| 3rd Qu.:2.000 | 3rd Qu.:1.000 | |||||
| Max. :4.000 | Max. :2.000 | |||||
Analiza graficzna
Celem tej części projektu jest prezentacja w postaci wykresów zależności między jakością kredytu a wybranymi zmiennymi jakościowymi i ilościowymi. Zgodnie z zasadami rysunek powinien zostać “zapowiedziany” tekście - np. na rys. 1 przedstawiono ….. Następnie należy przedstawić wnioski z rysunku.
Analiza zmiennych jakościowych
Dla zmiennych jakościowych można wykorzystać następujące wykresy (proszę dla każdej zmiennej przedstawić jeden wykres):
wykres słupkowy z nakładającymi się na siebie seriami:
ggplot(data=credit, aes(x=konto_czekowe, fill = jakosc)) +
geom_bar() +
xlab("Stan konta czekowego")+
ylab("liczba") +
theme_minimal() +
theme(legend.position="top") +
scale_x_discrete(limits=c("< 0", "0-200", ">200", "brak")) +
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od stanu konta czekowego
wykres słupkowych z oddzielnymi seriami:
ggplot(data=credit, aes(x=konto_czekowe, fill = jakosc)) +
geom_bar(position=position_dodge()) +
xlab("Stan konta czekowego")+
ylab("liczba") +
theme_minimal() +
theme(legend.position="top") +
scale_x_discrete(limits=c("< 0", "0-200", ">200", "brak")) +
theme(text=element_text(size=8))
Jakość kredytu w zależności od stanu konta czekowego
wykres procentowego udziału jakości kredytów w zależności od stanu konta czekowego:
ggplot(data=credit, aes(x=konto_czekowe, fill = jakosc)) +
geom_bar(position=position_fill()) +
xlab("Stan konta czekowego")+
ylab("liczba") +
theme_minimal() +
theme(legend.position="top") +
scale_x_discrete(limits=c("< 0", "0-200", ">200", "brak")) +
theme(text=element_text(size=8))
Jakość kredytu w zależności od stanu konta czekowego
Uzupełnieniem rysunków może być tabela w postaci tabeli przestawnej przedstawiającej liczbę kredytów danej jakości w zależności od stanu konta czekowego.
tab_jakosc<-as.data.frame.matrix(table(credit$konto_czekowe, credit$jakosc)) %>% rownames_to_column(var = "Stan konta czekowego")
#tab_jakosc
kbl(tab_jakosc, caption = "**Jakość kredytów w zalezności od stanu konta czekowego**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:3, width_min = '1.5in') %>%
add_header_above(header = c(" " = 1, "Jakość" = 2)) %>%
column_spec(1, border_right = TRUE)|
Jakość
|
||
|---|---|---|
| Stan konta czekowego | dobry | zly |
| < 0 | 139 | 135 |
| >200 | 49 | 14 |
| 0-200 | 164 | 105 |
| brak | 348 | 46 |
W podobny sposób można wygenerować wykresy dla innych zmiennych jakościowych. Należy pamiętać, aby w kodzie dokonać następujących zmian:
- zmienić x=konto_czekowe na x= nazwa zmiennej zapisana w taki sam sposób jak jest to w zbiorze “credit”,
- xlab(“Stan konta czekowego”) na xlab(“nazwa zmiennej),
- zmienić scale_x_discrete(limits=c(“< 0”, “0-200”, “>200”, “brak”)) na scale_x_discrete(limits=c(wartości wybranej zmiennej w ustalonej przez siebie kolejności). Usunięcie tej linijki kodu spowoduje, że wartości na osi x będą prezentowane w kolejności alfabetycznej. Aby sprawdzić jakie są dokładnie wartości dla danej zmiennej można wywołać kod:
levels(credit$historia)## [1] "brak" "istniejace_spł" "krytyczne" "opoznienia"
## [5] "wszystkie_spł"Analiza zmiennych jakościowych
Dla zmiennych ilościowych można wykorzystać następujące wykresy (proszę dla każdej zmiennej przedstawić jeden wykres):
histogram z nakładającymi się na siebie seriami danych:
ggplot(credit, aes(x = czas, fill = jakosc)) +
geom_histogram(bins = 15, color = "white") +
theme_minimal() +
xlab("długość kredytów [m-ce]")+
ylab("liczba") +
theme(legend.position="top") +
theme(text=element_text(size=8))
Jakość kredytu w zależności od długości kredytu
krzywą gęstości prawdopodobieństwa:
ggplot(credit, aes(x=czas, color=jakosc, fill=jakosc)) +
geom_density(alpha=.5) +
theme_minimal() +
xlab("długość kredytów [m-ce]")+
ylab("gęstość prawdopodobieństwa") +
theme(legend.position="top") +
theme(text=element_text(size=8)) +
facet_grid(. ~ jakosc)
Jakość kredytu w zależności od długości kredytu
wykresy pudełkowe:
ggplot(credit, aes(x = jakosc, y = czas, fill=jakosc)) +
geom_boxplot() +
theme_minimal() +
xlab("jakość")+
ylab("długość kredytów [m-ce]") +
theme(legend.position="top") +
theme(text=element_text(size=8))
Jakość kredytu w zależności od długości kredytu
W podobny sposób można wygenerować wykresy dla innych zmiennych jakościowych. Należy pamiętać, aby w kodzie dokonać następujących zmian:
- tam gdzie występuje “czas” zmienić na nazwę innej zmiennej ilościowej zgodnie z tym jak to jest w zbiorze danych credit,
- zmienić nazwy osi “długość kredytów [m-ce]” na odpowiednie do prezentowanej zmiennej.
Analiza struktury grupowej
Wprowadzenie
Należy wskazać cel tej części projektu oraz przedstawić etapy związane z przygotowaniem danych do analizy. Informacje te można znaleźć w dokumentacji.
Grupowanie niehierarchiczne na podstawie cech ilościowych
Wskazanie cech na podstawie których przeprowadzono grupowanie, omówienie na czym polega grupowanie niehierarchiczne, wskazanie liczby grup na które zostały podzielone obiekty. W analizie wyników należy skoncentrować się na statystykach opisowych analizowanych zmiennych w zależności od grupy.
grupa1<- credit[,c(2,5,8,13)]
normalizacja<-scale(grupa1)
distance<-dist(normalizacja, method = 'euclidean')
klastry <- kmeans(normalizacja, 2, nstart = 25)
grupa1$klaster <- as.factor(klastry$cluster)
klaster1<-filter(grupa1, klaster == "1")
#as.data.frame.matrix(summary(klaster1), row.names = F)
kbl(as.data.frame.matrix(summary(klaster1), row.names = F), caption = "**Statystyki opisowe analizowanych zmiennych dla obiektów z grupy 1**") %>%
kable_classic_2(full_width = T) %>%
row_spec(c(2,3,5), bold = T, color = "white", background = "#D7261E")| czas | kwota | rata_%doch | wiek | klaster |
|---|---|---|---|---|
| Min. : 4.00 | Min. : 250 | Min. :1.000 | Min. :19.00 | 1:790 |
| 1st Qu.:12.00 | 1st Qu.:1259 | 1st Qu.:2.000 | 1st Qu.:27.00 | 2: 0 |
| Median :15.00 | Median :1890 | Median :4.000 | Median :33.00 | |
| Mean :16.46 | Mean :2152 | Mean :3.066 | Mean :35.56 | |
| 3rd Qu.:24.00 | 3rd Qu.:2824 | 3rd Qu.:4.000 | 3rd Qu.:42.00 | |
| Max. :39.00 | Max. :7865 | Max. :4.000 | Max. :75.00 |
klaster2<-filter(grupa1, klaster == "2")
#as.data.frame.matrix(summary(klaster2), row.names = F)
kbl(as.data.frame.matrix(summary(klaster2), row.names = F), caption = "**Statystyki opisowe analizowanych zmiennych dla obiektów z grupy 2**") %>%
kable_classic_2(full_width = T) %>%
row_spec(c(2,3,5), bold = T, color = "white", background = "#D7261E")| czas | kwota | rata_%doch | wiek | klaster |
|---|---|---|---|---|
| Min. : 6.00 | Min. : 1845 | Min. :1.000 | Min. :21.0 | 1: 0 |
| 1st Qu.:30.00 | 1st Qu.: 5238 | 1st Qu.:2.000 | 1st Qu.:27.0 | 2:210 |
| Median :36.00 | Median : 6880 | Median :2.000 | Median :33.0 | |
| Mean :37.63 | Mean : 7480 | Mean :2.624 | Mean :35.5 | |
| 3rd Qu.:48.00 | 3rd Qu.: 9020 | 3rd Qu.:4.000 | 3rd Qu.:42.0 | |
| Max. :72.00 | Max. :18424 | Max. :4.000 | Max. :75.0 |
Grupowanie niehierarchiczne na podstawie wybranych zmiennych ilościowych i jakościowych
Należy przedstawić na podstawie jakich zmiennych dokonano grupowania, w jaki sposób wyznaczono odległość między obiektami, oraz w jaki sposób ustalono optymalną liczbę grup. W podsumowaniu należy wskazać wnioski wynikające z przeprowadzonego grupowania. Można dokonać charakterystyki wybranych grup na podstawie statystyk opisowych analizowanych zmiennych. Poniżej przedstawiono jako przykład statystyki opisowe dla grup: 1, 2 i 3.
grupa2<-credit[,c(1,2,3,5,7,9,12)]
gower_dist <- daisy(grupa2,
metric = "gower")
klastry2 <- pam(gower_dist,
diss = TRUE,
k = 13)
grupa2$klastry <-as.factor(klastry2$clustering)
klaster1<-filter(grupa2, klastry == "1")
#as.data.frame.matrix(summary(klaster1), row.names = F)
kbl(as.data.frame.matrix(summary(klaster1), row.names = F), caption = "**Statystyki opisowe analizowanych zmiennych dla obiektów z grupy 1**") %>%
kable_classic_2(full_width = T)| konto_czekowe | czas | historia | kwota | staz_pracy | plec | zabezpieczenie | klastry |
|---|---|---|---|---|---|---|---|
| < 0 : 5 | Min. : 4.00 | brak : 1 | Min. : 522 | <1 rok : 3 | K:11 | brak :14 | 1 :74 |
| >200 : 7 | 1st Qu.: 9.00 | istniejace_spł: 4 | 1st Qu.: 1074 | >7 :59 | M:63 | nieruchomosc :45 | 2 : 0 |
| 0-200: 8 | Median :12.00 | krytyczne :65 | Median : 1499 | 1-4 : 0 | samochod : 3 | 3 : 0 | |
| brak :54 | Mean :14.59 | opoznienia : 3 | Mean : 2221 | 4-7 : 9 | ubezpieczenie:12 | 4 : 0 | |
| 3rd Qu.:15.00 | wszystkie_spł : 1 | 3rd Qu.: 2172 | bezrobotny: 3 | 5 : 0 | |||
| Max. :60.00 | Max. :13756 | 6 : 0 | |||||
| (Other): 0 |
klaster2<-filter(grupa2, klastry == "2")
#as.data.frame.matrix(summary(klaster2), row.names = F)
kbl(as.data.frame.matrix(summary(klaster2), row.names = F), caption = "**Statystyki opisowe analizowanych zmiennych dla obiektów z grupy 2**") %>%
kable_classic_2(full_width = T)| konto_czekowe | czas | historia | kwota | staz_pracy | plec | zabezpieczenie | klastry |
|---|---|---|---|---|---|---|---|
| < 0 : 5 | Min. : 4.00 | brak : 2 | Min. : 343 | <1 rok :39 | K:58 | brak : 3 | 2 :67 |
| >200 : 6 | 1st Qu.: 9.00 | istniejace_spł:56 | 1st Qu.: 813 | >7 : 2 | M: 9 | nieruchomosc :53 | 1 : 0 |
| 0-200:43 | Median :12.00 | krytyczne : 4 | Median :1295 | 1-4 :12 | samochod : 7 | 3 : 0 | |
| brak :13 | Mean :14.42 | opoznienia : 0 | Mean :1895 | 4-7 : 9 | ubezpieczenie: 4 | 4 : 0 | |
| 3rd Qu.:18.00 | wszystkie_spł : 5 | 3rd Qu.:2302 | bezrobotny: 5 | 5 : 0 | |||
| Max. :48.00 | Max. :9960 | 6 : 0 | |||||
| (Other): 0 |
klaster3<-filter(grupa2, klastry == "3")
#as.data.frame.matrix(summary(klaster3), row.names = F)
kbl(as.data.frame.matrix(summary(klaster3), row.names = F), caption = "**Statystyki opisowe analizowanych zmiennych dla obiektów z grupy 3**") %>%
kable_classic_2(full_width = T)| konto_czekowe | czas | historia | kwota | staz_pracy | plec | zabezpieczenie | klastry |
|---|---|---|---|---|---|---|---|
| < 0 : 6 | Min. : 5.0 | brak : 0 | Min. : 368 | <1 rok : 7 | K: 5 | brak : 2 | 3 :69 |
| >200 : 3 | 1st Qu.:11.0 | istniejace_spł:50 | 1st Qu.: 1264 | >7 : 4 | M:64 | nieruchomosc : 9 | 1 : 0 |
| 0-200:47 | Median :15.0 | krytyczne : 6 | Median : 2273 | 1-4 : 7 | samochod : 9 | 2 : 0 | |
| brak :13 | Mean :18.7 | opoznienia :10 | Mean : 3075 | 4-7 :46 | ubezpieczenie:49 | 4 : 0 | |
| 3rd Qu.:24.0 | wszystkie_spł : 3 | 3rd Qu.: 3976 | bezrobotny: 5 | 5 : 0 | |||
| Max. :48.0 | Max. :14555 | 6 : 0 | |||||
| (Other): 0 |
Analiza zależności jakości kredytu od wybranych zmiennych ilościowych i jakościowych
Wprowadzenie
Należy wskazać cel tej części projektu i opisać wykorzystane narzędzia (statystyka Chi-kwadrat, współczynnika V Cramera).
Ocena zależności jakości kredytu od wybranych zmiennych
Należy przedstawić wyniki analizy dla wybranej jednej zmiennej ilościowej i 3 zmiennych jakościowych. W przypadku zmiennych ilościowych konieczne jest przeprowadzenie dyskretyzacja zmiennych tzn. przekształcenie zmiennych ciągłych w zmienne dyskretne (np. podział kredytobiorców na 3 grupy wiekowe). Granice podziału na grupy mogą mieć charakter subiektywny (przyjęte przez analityka), lub obiektywny (wynikają np. z przyjętej klasyfikacji kredytów ze względu na ich długość na kredyty krótko-, średnio i długookresowe). W przypadku zmiennych ilościowych konieczne jest doprowadzenie tablicy krzyżowej do postaci zbliżonej do kwadratu (liczba kolumn = liczbie wierszy). W przypadku zmiennych, których liczba poziomów jest znaczna należy dokonać agregacji tak aby uzyskać 2-3 poziomy dla zmiennej.
wpływ długości kredytu na jego jakość:
Do oceny można wykorzystać wyniki analizy przedstawione w postaci tabeli bądź wykresu
a<-c(1:12)
b<-c(13:24)
credit$czas_mod<- ifelse(credit$czas %in% a, "<1 rok",
ifelse(credit$czas %in% b, "1-2 lata", "pow. 2 lat"))
tab_xtab(var.row = credit$czas_mod, var.col = credit$jakosc, show.row.prc = T, show.summary = T)| czas_mod | jakosc | Total | |
|---|---|---|---|
| dobry | zly | ||
| <1 rok |
283 78.8 % |
76 21.2 % |
359 100 % |
| 1-2 lata |
289 70.3 % |
122 29.7 % |
411 100 % |
| pow. 2 lat |
128 55.7 % |
102 44.3 % |
230 100 % |
| Total |
700 70 % |
300 30 % |
1000 100 % |
χ2=35.895 · df=2 · Cramer’s V=0.189 · p=0.000 |
plot_xtab(credit$czas_mod, credit$jakosc, margin = "row",bar.pos = "stack",
coord.flip = TRUE, show.legend =TRUE, show.n = FALSE,
show.summary = TRUE) +
xlab("czas kredytu") +
theme_minimal() +
theme(legend.position="top")+
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od długości okresu kredytu
wpływ wieku kredytobiorcy na jakość kredytu:
a<-c(18:30)
b<-c(31:45)
credit$wiek_mod <- ifelse(credit$wiek %in% a, "18-30",
ifelse(credit$wiek %in% b, "31-45", "pow. 45"))
tab_xtab(var.row = credit$wiek_mod, var.col = credit$jakosc, show.row.prc = T, show.summary = T)| wiek_mod | jakosc | Total | |
|---|---|---|---|
| dobry | zly | ||
| 18-30 |
263 64 % |
148 36 % |
411 100 % |
| 31-45 |
298 73.9 % |
105 26.1 % |
403 100 % |
| pow. 45 |
139 74.7 % |
47 25.3 % |
186 100 % |
| Total |
700 70 % |
300 30 % |
1000 100 % |
χ2=12.038 · df=2 · Cramer’s V=0.110 · p=0.002 |
plot_xtab(credit$wiek_mod, credit$jakosc, margin = "row",bar.pos = "stack",
coord.flip = TRUE, show.legend =TRUE, show.n = FALSE,
show.summary = TRUE) +
xlab("wiek kredytodawcy") +
theme_minimal() +
theme(legend.position="top")+
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od wieku kredytobiorcy
wpływ salda konta czekowego na jakość kredytu:
credit$konto_czekowe_mod <- ifelse(credit$konto_czekowe == "brak", "brak",
ifelse(credit$konto_czekowe == "< 0", "ujemne", "dodatnie"))
tab_xtab(var.row = credit$konto_czekowe_mod, var.col = credit$jakosc, show.row.prc = T, show.summary = T)| konto_czekowe_mod | jakosc | Total | |
|---|---|---|---|
| dobry | zly | ||
| brak |
348 88.3 % |
46 11.7 % |
394 100 % |
| dodatnie |
213 64.2 % |
119 35.8 % |
332 100 % |
| ujemne |
139 50.7 % |
135 49.3 % |
274 100 % |
| Total |
700 70 % |
300 30 % |
1000 100 % |
χ2=116.851 · df=2 · Cramer’s V=0.342 · p=0.000 |
plot_xtab(credit$konto_czekowe_mod, credit$jakosc, margin = "row",bar.pos = "stack",
coord.flip = TRUE, show.legend =TRUE, show.n = FALSE,
show.summary = TRUE) +
xlab("konto czekowe") +
theme_minimal() +
theme(legend.position="top")+
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od stanu konta czekowego
wpływ historii kredytowej na jakość kredytu:
Korzystna historia w sytuacji regularnego spłacania istniejących kredytów, spłacenia wszystkich wcześniejszych kredytów, lub w przypadku braku historii. W pozostałych sytuacjach historia negatywna.
credit$historia_mod <- ifelse(credit$historia == "istniejace_spł" |
credit$historia == "wszystkie_spł" |
credit$historia == "brak", "korzystna", "niekorzystna")
tab_xtab(var.row = credit$historia_mod, var.col = credit$jakosc, show.row.prc = T, show.summary = T)| historia_mod | jakosc | Total | |
|---|---|---|---|
| dobry | zly | ||
| korzystna |
397 64.1 % |
222 35.9 % |
619 100 % |
| niekorzystna |
303 79.5 % |
78 20.5 % |
381 100 % |
| Total |
700 70 % |
300 30 % |
1000 100 % |
χ2=25.878 · df=1 · φ=0.163 · p=0.000 |
plot_xtab(credit$historia_mod, credit$jakosc, margin = "row",bar.pos = "stack",
coord.flip = TRUE, show.legend =TRUE, show.n = FALSE,
show.summary = TRUE) +
xlab("historia kredytowa") +
theme_minimal() +
theme(legend.position="top")+
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od historii kredytowej
wpływ płci kredytobiorcy na jakość kredytu:
tab_xtab(var.row = credit$plec, var.col = credit$jakosc, show.row.prc = T, show.summary = T)| plec | jakosc | Total | |
|---|---|---|---|
| dobry | zly | ||
| K |
201 64.8 % |
109 35.2 % |
310 100 % |
| M |
499 72.3 % |
191 27.7 % |
690 100 % |
| Total |
700 70 % |
300 30 % |
1000 100 % |
χ2=5.349 · df=1 · φ=0.075 · p=0.021 |
plot_xtab(credit$plec, credit$jakosc, margin = "row", bar.pos = "stack",
coord.flip = TRUE, show.legend =TRUE, show.n = TRUE,
show.summary = TRUE) +
xlab("płeć") +
theme_minimal() +
theme(legend.position="top")+
theme(text=element_text(size=8)) 
Jakość kredytu w zależności od płci
Reguły asocjacji w credit scoringu
Wprowadzenie
Należy przedstawić cel tej części projektu wskazać czym są reguły
asocjacji, jakie miary służą do ich oceny na czym polega przygotowanie
danych do analizy. Informacje te znajdują się w dokumencie Metody4.
Uwaga Ze względu na to, że wcześniejszej części
projektu do zbioru danych credit dodano nowe kolumny, tą
część projektu należy rozpocząć od ponownego wgrania danych
credit do środowiska.
load("C:/Users/mbuko/OneDrive/Dokumenty/credit.RData")
credit$`rata_%doch`<-as.factor(credit$`rata_%doch`)
credit$zamieszkanie <- as.factor(credit$zamieszkanie)
credit$l_kredytow <- as.factor(credit$l_kredytow)
credit$l_osob<-as.factor(credit$l_osob)
reguly<-as(credit[,c(1:9,11:19,21)], "transactions")Najczęściej występujące produkty w koszykach kredytowych:
itemFrequencyPlot(reguly, topN=15, xlab = "cechy", ylab = "częstotliwość \n wystąpień")
Najczęściej występujące cechy kredytobiorców
Reguły asocjacji dotyczące dobrych kredytów
Należy przedstawić przyjęte do analizy poziomy confidence i suport, podać liczbę wyszukanych reguł oraz scharakteryzować je za pomocą statystyk opisowych.
dobry_reguly<-apriori(reguly, parameter = list(support = 0.3, confidence = 0.5),
appearance = list(rhs = "jakosc=dobry"))#as.data.frame.matrix(summary(dobry_reguly)@quality, row.names = F)[,1:2]
a<-as.data.frame.matrix(summary(dobry_reguly)@quality, row.names = F)[,1:2]
kbl(a, caption = "**Statystyki opisowe dla reguł *dobrych* kredytów**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:2, width_min = '2in')| support | confidence |
|---|---|
| Min. :0.3030 | Min. :0.6394 |
| 1st Qu.:0.3270 | 1st Qu.:0.6904 |
| Median :0.3610 | Median :0.7206 |
| Mean :0.3888 | Mean :0.7235 |
| 3rd Qu.:0.4170 | 3rd Qu.:0.7494 |
| Max. :0.7000 | Max. :0.9182 |
Support i confidence reguł dotyczących dobrych kredytów przedstawione za pomocą wykresu
plot(dobry_reguly)
Reguły asocjacji dla dobrych kredytów
Omówienie 10 reguł o największym poziomie ufności dotyczących kredytów dobrych
podreguly_jakosc<-head(dobry_reguly, n = 10, by = "confidence")
inspect(podreguly_jakosc)## lhs rhs support confidence coverage lift count
## [1] {konto_czekowe=brak,
## inne_zobow=brak} => {jakosc=dobry} 0.303 0.9181818 0.330 1.311688 303
## [2] {konto_czekowe=brak} => {jakosc=dobry} 0.348 0.8832487 0.394 1.261784 348
## [3] {plec=M,
## inne_zobow=brak,
## rodzaj_miesz=wlasne} => {jakosc=dobry} 0.327 0.7917676 0.413 1.131097 327
## [4] {inne_zobow=brak,
## rodzaj_miesz=wlasne} => {jakosc=dobry} 0.443 0.7690972 0.576 1.098710 443
## [5] {rodzaj_miesz=wlasne,
## kwalifikacje=wykwalifikowany} => {jakosc=dobry} 0.342 0.7566372 0.452 1.080910 342
## [6] {inne_zobow=brak,
## rodzaj_miesz=wlasne,
## l_osob=1} => {jakosc=dobry} 0.376 0.7565392 0.497 1.080770 376
## [7] {plec=M,
## rodzaj_miesz=wlasne} => {jakosc=dobry} 0.390 0.7543520 0.517 1.077646 390
## [8] {plec=M,
## inne_zobow=brak,
## l_osob=1} => {jakosc=dobry} 0.338 0.7527840 0.449 1.075406 338
## [9] {plec=M,
## inne_zobow=brak} => {jakosc=dobry} 0.417 0.7527076 0.554 1.075297 417
## [10] {rodzaj_miesz=wlasne,
## kwalifikacje=wykwalifikowany,
## l_osob=1} => {jakosc=dobry} 0.303 0.7518610 0.403 1.074087 303Reguły asocjacji dotyczące złych kredytów
Zakres opisu taki sam jak w przypadku reguł dotyczących dobrych kredytów
zly_reguly<-apriori(reguly, parameter = list(support = 0.1, confidence = 0.35),
appearance = list(rhs = "jakosc=zly"))#as.data.frame.matrix(summary(zly_reguly)@quality, row.names = F)[,1:2]
a<-as.data.frame.matrix(summary(zly_reguly)@quality, row.names = F)[,1:2]
kbl(a, caption = "**Statystyki opisowe dla reguł *złych* kredytów**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:2, width_min = '2in')| support | confidence |
|---|---|
| Min. :0.1010 | Min. :0.3516 |
| 1st Qu.:0.1060 | 1st Qu.:0.3623 |
| Median :0.1140 | Median :0.3719 |
| Mean :0.1215 | Mean :0.3923 |
| 3rd Qu.:0.1285 | 3rd Qu.:0.3890 |
| Max. :0.2170 | Max. :0.5205 |
plot(zly_reguly)
Reguły asocjacji dla dobrych kredytów
podreguly_jakosc2<-head(zly_reguly, n = 10, by = "confidence")
inspect(podreguly_jakosc2)## lhs rhs support confidence
## [1] {konto_czekowe=< 0, oszczednosci=<100} => {jakosc=zly} 0.114 0.5205479
## [2] {konto_czekowe=< 0, l_osob=1} => {jakosc=zly} 0.114 0.5135135
## [3] {konto_czekowe=< 0} => {jakosc=zly} 0.135 0.4927007
## [4] {czas=[24,72], oszczednosci=<100} => {jakosc=zly} 0.115 0.4872881
## [5] {konto_czekowe=< 0, inne_zobow=brak} => {jakosc=zly} 0.106 0.4818182
## [6] {oszczednosci=<100, rata_%doch=4} => {jakosc=zly} 0.114 0.4056940
## [7] {czas=[24,72], l_kredytow=1} => {jakosc=zly} 0.102 0.3984375
## [8] {konto_czekowe=0-200} => {jakosc=zly} 0.105 0.3903346
## [9] {czas=[24,72], l_osob=1} => {jakosc=zly} 0.136 0.3885714
## [10] {oszczednosci=<100, l_kredytow=1} => {jakosc=zly} 0.145 0.3877005
## coverage lift count
## [1] 0.219 1.735160 114
## [2] 0.222 1.711712 114
## [3] 0.274 1.642336 135
## [4] 0.236 1.624294 115
## [5] 0.220 1.606061 106
## [6] 0.281 1.352313 114
## [7] 0.256 1.328125 102
## [8] 0.269 1.301115 105
## [9] 0.350 1.295238 136
## [10] 0.374 1.292335 145Klasyfikacja OneRule
Wprowadzenie
Należy wskazać na czym polega klasyfikacja z wykorzystaniem metody OneRule (1R). Przedstawić sposób przygotowania danych do analizy zgodnie z opisem w dokumencie Metody.
set.seed(121) # for reproducibility
random <- sample(1:nrow(credit), 0.75 * nrow(credit))
data_train<-bin(credit[random, ], 3)Budowa klasyfikatora
Przedstawić dokładność klasyfikacji dla wszystkich analizowanych zmiennych i wskazać, która z nich jest najlepsza. Wskazać jak w zależności od poziomu najlepszej zmiennej zmienia się jakość kredytu
model_train <- OneR(data_train, verbose = TRUE)##
## Attribute Accuracy
## 1 * historia 73.47%
## 2 kwota 72%
## 3 czas 71.47%
## 4 konto_czekowe 71.2%
## 4 cel 71.2%
## 4 oszczednosci 71.2%
## 4 staz_pracy 71.2%
## 4 rata_%doch 71.2%
## 4 plec 71.2%
## 4 poreczyciel 71.2%
## 4 zamieszkanie 71.2%
## 4 zabezpieczenie 71.2%
## 4 wiek 71.2%
## 4 inne_zobow 71.2%
## 4 rodzaj_miesz 71.2%
## 4 l_kredytow 71.2%
## 4 kwalifikacje 71.2%
## 4 l_osob 71.2%
## 4 telefon 71.2%
## 4 obcokrajowiec 71.2%
## ---
## Chosen attribute due to accuracy
## and ties method (if applicable): '*'summary(model_train)##
## Call:
## OneR.data.frame(x = data_train, verbose = TRUE)
##
## Rules:
## If historia = brak then jakosc = zly
## If historia = istniejace_spł then jakosc = dobry
## If historia = krytyczne then jakosc = dobry
## If historia = opoznienia then jakosc = dobry
## If historia = wszystkie_spł then jakosc = zly
##
## Accuracy:
## 551 of 750 instances classified correctly (73.47%)
##
## Contingency table:
## historia
## jakosc brak istniejace_spł krytyczne opoznienia wszystkie_spł Sum
## dobry 12 * 266 * 197 * 49 10 534
## zly * 21 122 32 23 * 18 216
## Sum 33 388 229 72 28 750
## ---
## Maximum in each column: '*'
##
## Pearson's Chi-squared test:
## X-squared = 62.942, df = 4, p-value = 6.978e-13Ocena jakości klasyfikacji na zbiorze testowym
Ocenę(#ocena) przeprowadzić na podstawie macierzy błędnych klasyfikacji. Na jej podstawie obliczyć i podać interpretację - sposób interpretacji znajduje się w dokumencie:
- precyzji (precision):
- czułości (recall):
- specyficzności (specificity):
- F miary (średnia harmoniczna z precyzji i czułości):
Poszczególne wyrażenia występujące we wzorach oblicza się na podstawie wartości występujących w macierzy błędnych klasyfikacji, zgodnie ze schematem:
| Faktyczny + | Faktyczny - | |
|---|---|---|
| Predykcja + | TP | FP |
| Predykcja - | FN | TN |
data_test <- credit[-random, ]
prediction <- predict(model_train, data_test)
eval_model(prediction, data_test)##
## Confusion matrix (absolute):
## Actual
## Prediction dobry zly Sum
## dobry 152 70 222
## zly 14 14 28
## Sum 166 84 250
##
## Confusion matrix (relative):
## Actual
## Prediction dobry zly Sum
## dobry 0.61 0.28 0.89
## zly 0.06 0.06 0.11
## Sum 0.66 0.34 1.00
##
## Accuracy:
## 0.664 (166/250)
##
## Error rate:
## 0.336 (84/250)
##
## Error rate reduction (vs. base rate):
## 0 (p-value = 0.5296)Porównać dokładność klasyfikacji (% błędnie sklasyfikowanych obiektów) z dokładnością klasyfikatora 0R (wszystkie obiekty otrzymują tą klasę, która jest częstsza w zbiorze testowym).
sum(data_test$jakosc == "zly")/nrow(data_test)## [1] 0.336Klasyfikacja k-NN
Wprowadzenie
Należy wyjaśnić na czym polega klasyfikacja k-NN, omówić proces przygotowania danych (ze wskazaniem danych o charakterze porządkowym), przedstawić sposób liczenia odległości między obiektami.
credit$`rata_%doch`<-as.numeric(credit$`rata_%doch`)
credit$zamieszkanie<-as.numeric(credit$zamieszkanie)
credit$l_kredytow<-as.numeric(credit$l_kredytow)
credit$l_osob<-as.numeric(credit$l_osob)
credit$konto_czekowe <- factor(
x = credit$konto_czekowe,
levels = c("< 0", "brak", "0-200",">200"),
ordered = T)
credit$oszczednosci <- factor(
x = credit$oszczednosci,
levels = c( "brak" , "<100", "100-500", "500-1000" ,">1000" ),
ordered = T)
credit$staz_pracy <- factor(
x = credit$staz_pracy,
levels = c("bezrobotny", "<1 rok", "1-4" , "4-7", ">7" ),
ordered = T)
set.seed(121) # for reproducibility
random <- sample(1:nrow(credit), 0.75 * nrow(credit))
data_train<-credit[random, ]
data_test <- credit[-random, ]Model k-NN przy optymalnych parametrach
Należy napisać, że w wyniku obliczeń przeprowadzonych dla danych treningowych określono, że największą dokładność modelu uzyskać można przy następujących wartościach parametrów:
- k = 13,
- distance = 2,
- kernel = “gaussian”.
knn <- kknn(formula = jakosc ~ .,
train=data_train,
test=data_test,
k = 13,
distance = 2,
kernel = "gaussian",
scale = T
)Ocenę jakości modelu przeprowadzono na podstawie danych testowych z wykorzystaniem macierzy błędnych klasyfikacji oraz procentu błędów
macierz_kNN<-as.data.frame.matrix(
table(
przewidywane = knn$fitted.values,
rzeczywiste = data_test$jakosc)) %>%
rownames_to_column(var="Przewidywane")
#macierz_kNN
kbl(macierz_kNN, caption = "**Macierz błędnych klasyfikacji**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:3, width_min = '2in') %>%
add_header_above(header = c(" " = 1, "Rzeczywiste" = 2)) %>%
column_spec(1, border_right = TRUE)|
Rzeczywiste
|
||
|---|---|---|
| Przewidywane | dobry | zly |
| dobry | 161 | 66 |
| zly | 5 | 18 |
Procent błędu dla klasyfikatora k-NN wynosi
mean(data_test$jakosc != knn$fitted.values) # błąd dla modelu## [1] 0.284Dla porównania procent błędu dla klasyfikatora 0R (wszystkie obiekty otrzymują tą klasę, która jest częstsza w zbiorze testowym).
sum(data_test$jakosc == "zly")/nrow(data_test) #błąd przy klasyfikacji 0R## [1] 0.336Ocenić jakość klasyfikacji za pomocą wskaźników opisanych w części związanej z klasyfikacją OneRule.
Drzewa klasyfikacyjne
Wprowadzenie
Należy wskazać cel tej części, wyjaśnić na czym polega klasyfikacja z wykorzystaniem drzew klasyfikacyjnych, omówić sposób przygotowania danych oraz podział zbioru na zbiór treningowy i testowy.
set.seed(121) # for reproducibility
random <- sample(1:nrow(credit), 0.75 * nrow(credit))
data_train<-credit[random, ]
data_test <- credit[-random, ]Budowa drzewa optymalnego
Przedstawić w jaki sposób przeprowadza się “budowę” drzewa (skonstruowanie drzewa maksymalnego, a następnie jego przycięcie zgodnie z regułą jednego błędu standardowego). Ustalenie punktu przycięcia na podstawie poniższej tabeli i rysunku
drzewo.max <- rpart(jakosc ~ ., data = data_train,
control = rpart.control(cp = 0,
xval = 10))
bledy <- printcp(drzewo.max)tab_bledy<-as.data.frame.matrix(bledy)
#tab_bledy
kbl(tab_bledy, caption = "**Błędy na próbie uczącej (rel error) i w sprawdzaniu krzyżowym (xerror) w zależności od wielkości drzewa**") %>%
kable_classic_2(full_width = T)| CP | nsplit | rel error | xerror | xstd |
|---|---|---|---|---|
| 0.0648148 | 0 | 1.0000000 | 1.0000000 | 0.0574134 |
| 0.0370370 | 2 | 0.8703704 | 0.9814815 | 0.0570919 |
| 0.0231481 | 3 | 0.8333333 | 0.9212963 | 0.0559781 |
| 0.0208333 | 5 | 0.7870370 | 0.9027778 | 0.0556134 |
| 0.0185185 | 7 | 0.7453704 | 0.9259259 | 0.0560676 |
| 0.0162037 | 9 | 0.7083333 | 0.9166667 | 0.0558879 |
| 0.0123457 | 12 | 0.6574074 | 0.9490741 | 0.0565055 |
| 0.0115741 | 16 | 0.6064815 | 0.9675926 | 0.0568444 |
| 0.0092593 | 18 | 0.5833333 | 0.9675926 | 0.0568444 |
| 0.0069444 | 20 | 0.5648148 | 0.9861111 | 0.0571732 |
| 0.0046296 | 22 | 0.5509259 | 0.9861111 | 0.0571732 |
| 0.0023148 | 24 | 0.5416667 | 0.9814815 | 0.0570919 |
| 0.0000000 | 30 | 0.5277778 | 0.9907407 | 0.0572539 |
matplot(x = bledy[, "nsplit"],
y = bledy[, c("rel error", # błąd na próbie uczącej (w stosunku do błędu dla korzenia)
"xerror")], # błąd w sprawdzaniu krzyżowym
type = "l",
xlab = "wielkość drzewa",
ylab = "błąd")
legend(x = "bottom", legend = c("błąd na próbie uczącej",
"błąd w sprawdzaniu krzyżowym"),
col = c("black", "red"),
lty = 1:2)
Poziom błędów w zależności od wielkości drzewa
Optymalna postać drzewa
tmp1 <- which.min(bledy[, "xerror"]) # min błąd w sprawdzaniu krzyżowym
tmp2 <- sum(bledy[tmp1, c("xerror", "xstd")]) # min błąd + odchylenie standardowe
optymalny <- which(bledy[, "xerror"] < tmp2)[1] # nr optymalnego drzewa
drzewo.opt <- prune(drzewo.max, cp = bledy[optymalny, "CP"]) # przycięcie drzewa
rpart.plot(drzewo.opt)
Ocena jakości klasyfikacji
Ocenę jakości klasyfikacji dokonać na podstawie macierzy błędnych klasyfikacji oraz procentu błędnych klasyfikacji:
predykcja <- predict(object = drzewo.opt,
newdata = data_test,
type = "class")
macierz_drzewo<-as.data.frame.matrix(
table(przewidywane = predykcja, rzeczywiste = data_test$jakosc)) %>%
rownames_to_column(var = "Przewidywane")
#macierz_drzewo
kbl(macierz_drzewo, caption = "**Macierz błędnych klasyfikacji**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:3, width_min = '2in') %>%
add_header_above(header = c(" " = 1, "Rzeczywiste" = 2)) %>%
column_spec(1, border_right = TRUE)|
Rzeczywiste
|
||
|---|---|---|
| Przewidywane | dobry | zly |
| dobry | 154 | 69 |
| zly | 12 | 15 |
Procent błędu dla drzewa wynosi
sum(predykcja != data_test$jakosc) / nrow(data_test) # błąd dla modelu## [1] 0.324Dla porównania procent błędu dla klasyfikatora 0R (wszystkie obiekty otrzymują tą klasę, która jest częstsza w zbiorze testowym).
sum(data_test$jakosc == "zly")/nrow(data_test) #błąd przy klasyfikacji 0R## [1] 0.336Ocenić jakość klasyfikacji za pomocą wskaźników opisanych w części związanej z klasyfikacją OneRule.
Model przy różnych kosztach błędów
Ocena jakości modelu może zostać ptrzeprowadzona nie tylko na podstawie dokładności klasyfikacji, ale także na podstawie kosztów błędów wynikających z niewłaściwej klasyfikacji. Przykładowo z punktu widzenia banku koszt akceptacji wniosku, który powinien zostać odrzucony może być dwa razy większy od kosztu nieprzyznania kredytu osobie, która byłaby dobrym kredytobiorcą. (Bank więcej traci dając kredyt tym którzy go nie powinni otrzymać niż niedając kredytu tym którzy powinni go dostać). W takiej sytuacji drzewo klasyfikacyjne ma następującą postać
koszty2 <- matrix(c(0, 2, 1, 0), 2, 2,
dimnames = list(rzeczywiste = c("yes", "no"),
prognozowane = c("yes", "no")))
drz.credit.koszt <- rpart(jakosc ~., data = data_train,
parms = list(loss = koszty2))
rpart.plot(drz.credit.koszt, type = 0)
predykcja2 <- predict(object = drz.credit.koszt,
newdata = data_test,
type = "class")
mklas.koszt <- as.data.frame.matrix(
table(przewidywane = predykcja2, rzeczywiste = data_test$jakosc)) %>%
rownames_to_column(var = "Przewidywane")
#mklas.koszt
kbl(mklas.koszt, caption = "**Macierz błędnych klasyfikacji**") %>%
kable_classic_2(full_width = F) %>%
column_spec(1:3, width_min = '2in') %>%
add_header_above(header = c(" " = 1, "Rzeczywiste" = 2)) %>%
column_spec(1, border_right = TRUE)|
Rzeczywiste
|
||
|---|---|---|
| Przewidywane | dobry | zly |
| dobry | 133 | 42 |
| zly | 33 | 42 |
Procentu błędów:
sum(predykcja2 != data_test$jakosc) / nrow(data_test) ## [1] 0.3Porównanie kosztu błędnych klasyfikacji przy jednakowym poziomie kosztów:
conf_matrix<-as.matrix(table(przewidywane = predykcja, rzeczywiste = data_test$jakosc))
koszty <- matrix(c(0, 1, 2, 0), 2, 2,
dimnames = list(
prognozowane = c("dobry", "zly"),
rzeczywiste = c("dobry", "zly")))
sum(koszty*conf_matrix)## [1] 150i przy dwukrotnie większym koszcie wynikającego z udzielenia złego kredytu
mklas.koszt<-as.matrix(table(przewidywane = predykcja2, rzeczywiste = data_test$jakosc))
sum(koszty * mklas.koszt)## [1] 117Ocenić jakość klasyfikacji za pomocą wskaźników opisanych w części związanej z klasyfikacją OneRule.
