Podstawowe operacje w R - część 4.
Czyszczenie danych
Zadanie domowe
Korzystając z paczki danych “germancredit” dotyczącą oceny kredytowej (creditability) wybranych klientów pewnego banku:
Czy w zbiorze danych mamy obserwacje brakujące?
Proszę dokonać kategoryzacji zmiennej “age.in.years” (wiek w latach) wg oceny kredytowej “creditability”.
Podaj i zinterpretuj wskaźniki informacyjne. Oceń skośność zmiennych ilościowych.
Sprawdź, czy nie mamy obserwacji odstających dla zmiennej “age.in.years” (wiek w latach). Jeśli są - dokonaj imputacji wybraną przez siebie metodą.
library(evtree)## Warning: pakiet 'evtree' został zbudowany w wersji R 4.2.2## Ładowanie wymaganego pakietu: partykit## Warning: pakiet 'partykit' został zbudowany w wersji R 4.2.2## Ładowanie wymaganego pakietu: libcoin## Warning: pakiet 'libcoin' został zbudowany w wersji R 4.2.2## Ładowanie wymaganego pakietu: mvtnormdata("GermanCredit")
summary(GermanCredit)## status duration
## ... < 0 DM :274 Min. : 4.0
## 0 <= ... < 200 DM :269 1st Qu.:12.0
## ... >= 200 DM / salary for at least 1 year: 63 Median :18.0
## no checking account :394 Mean :20.9
## 3rd Qu.:24.0
## Max. :72.0
##
## credit_history purpose
## no credits taken/all credits paid back duly: 40 domestic appliances:280
## all credits at this bank paid back duly : 49 car (new) :234
## existing credits paid back duly till now :530 radio/television :181
## delay in paying off in the past : 88 car (used) :103
## critical account/other credits existing :293 others : 97
## retraining : 50
## (Other) : 55
## amount savings employment_duration
## Min. : 250 ... < 100 DM :603 unemployed : 62
## 1st Qu.: 1366 100 <= ... < 500 DM :103 ... < 1 year :172
## Median : 2320 500 <= ... < 1000 DM : 63 1 <= ... < 4 years:339
## Mean : 3271 ... >= 1000 DM : 48 4 <= ... < 7 years:174
## 3rd Qu.: 3972 unknown/no savings account:183 ... >= 7 years :253
## Max. :18424
##
## installment_rate personal_status_sex
## Min. :1.00 male : divorced/separated : 50
## 1st Qu.:2.00 female : divorced/separated/married:310
## Median :3.00 male : single :548
## Mean :2.97 male : married/widowed : 92
## 3rd Qu.:4.00 female : single : 0
## Max. :4.00
##
## other_debtors present_residence
## none :907 Min. :1.00
## co-applicant: 41 1st Qu.:2.00
## guarantor : 52 Median :3.00
## Mean :2.85
## 3rd Qu.:4.00
## Max. :4.00
##
## property age
## real estate :282 Min. :19.0
## building society savings agreement/life insurance:232 1st Qu.:27.0
## car or other :332 Median :33.0
## unknown/no property :154 Mean :35.5
## 3rd Qu.:42.0
## Max. :75.0
##
## other_installment_plans housing number_credits
## bank :139 rent :179 Min. :1.00
## stores: 47 own :713 1st Qu.:1.00
## none :814 for free:108 Median :1.00
## Mean :1.41
## 3rd Qu.:2.00
## Max. :4.00
##
## job
## unemployed/unskilled - non-resident : 22
## unskilled - resident :200
## skilled employee/official :630
## management/self-employed/highly qualified employee/officer:148
##
##
##
## people_liable telephone foreign_worker credit_risk
## Min. :1.00 no :596 yes:963 good:700
## 1st Qu.:1.00 yes:404 no : 37 bad :300
## Median :1.00
## Mean :1.16
## 3rd Qu.:1.00
## Max. :2.00
## sum(is.na(GermanCredit))## [1] 0rules <- validator(
people_liable > 0
,number_credits > 0
,age > 1
,amount > 0
,duration > 0
)
fixable_data <- replace_errors(GermanCredit, rules)
sum(is.na(GermanCredit))## [1] 0sum(is.na(fixable_data))## [1] 0GermanCredit$creditability <- as.numeric(GermanCredit$credit_risk)
GermanCredit$creditability <- transform(GermanCredit$creditability, method = "minmax")
bin <- binning_by(GermanCredit, y="creditability", x="age")
summary(bin)## ── Binning Table ──────────────────────── Several Metrics ──
## Bin CntRec CntPos CntNeg RatePos RateNeg Odds WoE IV JSD
## 1 [19,25] 190 80 110 0.26667 0.15714 0.72727 0.52884 0.05792 0.00716
## 2 (25,75] 810 220 590 0.73333 0.84286 0.37288 -0.13920 0.01525 0.00190
## 3 Total 1000 300 700 1.00000 1.00000 0.42857 NA 0.07317 0.00906
## AUC
## 1 0.02095
## 2 0.53381
## 3 0.55476
##
## ── General Metrics ─────────────────────────────────────────
## • Gini index : 0.10952
## • IV (Jeffrey) : 0.07317
## • JS (Jensen-Shannon) Divergence : 0.00906
## • Kolmogorov-Smirnov Statistics : 0.10952
## • HHI (Herfindahl-Hirschman Index) : 0.6922
## • HHI (normalized) : 0.3844
## • Cramer's V : 0.12794
##
## ── Significance Tests ──────────────────── Chisquare Test ──
## Bin A Bin B statistics p_value
## 1 [19,25] (25,75] 16.3681 0.0000521562#Gini Index mówi o nierówności rozkładu, wskazuje na nierówność na poziomie 11% oceny kredytowej w stosunku do wieku
#JS (Jensen-Shannon) Divergence - rozbieżność w rozkładach dwóch kategorii na poziomie 1% - niewielka
#Kolmogorov-Smirnov Statistics - 11%, poziom podobieństwa dystrybucji dwóch populacji
#HHI - mierzy koncentrację oraz kompetetywność, w tym przypadku prawdopodobnie nie znajduje zastosowania (wartość i tak jest bardzo mała, rynek pożyczek nie jest kompetetywny od strony konsumenta)
#Cramers V - 12.8%, przyjmuje się, że przy poziomie 10% zmienne są od siebie zależne, można więc założyć zależność między wiekiem a zdolnością kredytową
plot(bin)
find_skewness(GermanCredit, index = F,value = T)## duration amount installment_rate present_residence
## 1.093 1.947 -0.531 -0.272
## age number_credits people_liable
## 1.019 1.271 1.907#duration (1.093) - większość kredytów przydzielana jest na krótszy okres
#Amount (1.947) - Duża część kredytów jest udzielana na niższe kwoty
#number_credits (1.271) - Większość osób zapożyczających się ma aktualnie mniej kredytów to spłacania od średniej
#people_liable (1.907) - Większość kredytów zaciągana jest przez jedną osobę, nie wspólnie
#installment_rate (-0,531) - Większość osób wchodzi z kapitałem własnym powyżej średniej
#present_residence (-0,272) - Większość kredytobiorców przebywa w obecnym miejscu zamieszkania dłużej niż średnia'
GermanCredit$age<-imputate_outlier(GermanCredit, age, method="capping")
summary(GermanCredit$age)## Impute outliers with capping
##
## * Information of Imputation (before vs after)
## Original Imputation
## described_variables "value" "value"
## n "1000" "1000"
## na "0" "0"
## mean "35.546" "35.350"
## sd "11.3755" "10.8530"
## se_mean "0.359724" "0.343202"
## IQR "15" "15"
## skewness "1.020739" "0.821878"
## kurtosis " 0.595780" "-0.132573"
## p00 "19" "19"
## p01 "20" "20"
## p05 "22" "22"
## p10 "23" "23"
## p20 "26" "26"
## p25 "27" "27"
## p30 "28" "28"
## p40 "30" "30"
## p50 "33" "33"
## p60 "36" "36"
## p70 "39" "39"
## p75 "42" "42"
## p80 "45" "45"
## p90 "52" "52"
## p95 "60" "60"
## p99 "67.01" "63.00"
## p100 "75" "64"plot(GermanCredit$age)