Część Opisowa
Wczytanie danych i pakietów
Sprawdzenie danych
str(Dane_projekt)
## tibble [40,000 × 13] (S3: tbl_df/tbl/data.frame)
## $ LP : num [1:40000] 1 2 3 4 5 6 7 8 9 10 ...
## $ data_akceptacji : POSIXct[1:40000], format: "2005-04-17" "2005-04-17" ...
## $ grupa_ryzyka : num [1:40000] 2 2 1 1 3 1 1 2 1 3 ...
## $ kod_partnera : num [1:40000] 2 2 3 1 1 3 1 2 1 2 ...
## $ typ_umowy : chr [1:40000] "R" "N" "N" "R" ...
## $ scoring_FICO : num [1:40000] 702 719 802 723 690 681 805 726 765 693 ...
## $ okres_kredytu : num [1:40000] 48 72 60 60 72 60 36 60 60 60 ...
## $ kwota_kredytu : num [1:40000] 26500 35000 28000 20751 20000 ...
## $ oproc_refin : num [1:40000] 0.0399 0 0 0.0675 0 0 0 0.0599 0 0 ...
## $ oproc_konkur : num [1:40000] 0.0499 0.0479 0.0399 0.0499 0.0529 0.0399 0.0405 0.0499 0.0399 0.0399 ...
## $ koszt_pieniadza : num [1:40000] 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 0.011 ...
## $ oproc_propon : num [1:40000] 0.0659 0.0599 0.0355 0.0489 0.0679 0.0385 0.0389 0.0525 0.0385 0.0609 ...
## $ akceptacja_klienta: num [1:40000] 0 0 0 1 0 0 1 0 0 0 ...
sapply(Dane_projekt, class)
## $LP
## [1] "numeric"
##
## $data_akceptacji
## [1] "POSIXct" "POSIXt"
##
## $grupa_ryzyka
## [1] "numeric"
##
## $kod_partnera
## [1] "numeric"
##
## $typ_umowy
## [1] "character"
##
## $scoring_FICO
## [1] "numeric"
##
## $okres_kredytu
## [1] "numeric"
##
## $kwota_kredytu
## [1] "numeric"
##
## $oproc_refin
## [1] "numeric"
##
## $oproc_konkur
## [1] "numeric"
##
## $koszt_pieniadza
## [1] "numeric"
##
## $oproc_propon
## [1] "numeric"
##
## $akceptacja_klienta
## [1] "numeric"
# Zmienne:
# data_akceptacji - data
# grupa_ryzyka - kategoria
# kod_partnera - kategoria
# typ_umowy - kategoria („N” – nowy samochód, „U” – samochód używany, „R” – refinansowanie kredytu)
# scoring_FICO - liczba
# okres_kredytu - liczba (miesiące)
# kwota_kredytu - liczba
# oproc.refin - liczba (dla typu umowy „R”)
# oproc_konkur - liczba
# koszt_pieniadza - liczba
# oproc_propon - liczba
# akceptacja_klienta - kategoria (zmienna celu -> 0 = brak akceptacji, 1 = akceptacja )
# Sprawdzenie braków
sum(is.na(Dane_projekt))
## [1] 0
# nie ma braków
Statystyki opisowe - dla ilościowych
zm_ilosciowe <- c("scoring_FICO", "kwota_kredytu", "oproc_konkur", "koszt_pieniadza", "oproc_propon")
oprocentowanie_refin <- Dane_projekt[Dane_projekt$typ_umowy == "R", ] # osobno, tylko dla typu umowy "R"
# Funkcja do obliczenia statystyk
calculate_stats <- function(data, var_name) {
stats <- c(
Mean = mean(data[[var_name]], na.rm = TRUE),
Median = median(data[[var_name]], na.rm = TRUE),
Max = max(data[[var_name]], na.rm = TRUE),
Min = min(data[[var_name]], na.rm = TRUE),
SD = sd(data[[var_name]], na.rm = TRUE),
Range = diff(range(data[[var_name]], na.rm = TRUE)),
Skewness = skewness(data[[var_name]], na.rm = TRUE),
Kurtosis = kurtosis(data[[var_name]], na.rm = TRUE),
IQR = IQR(data[[var_name]], na.rm = TRUE)
)
return(stats)
}
# Obliczenia dla zmiennych ilościowych
stats_table <- sapply(zm_ilosciowe, function(var) calculate_stats(Dane_projekt, var))
# Dla zmiennej 'oprocentowanie.refin'
stats_table_refin <- sapply("oproc_refin", function(var) calculate_stats(oprocentowanie_refin, var))
# Połączenie wyników
final_stats <- cbind(stats_table, stats_table_refin)
final_stats <- t(final_stats)
options(scipen = 999)
print(final_stats)
## Mean Median Max Min
## scoring_FICO 720.72917500 717.0000 851.00000 601.0000
## kwota_kredytu 24211.65153625 23000.0000 100000.00000 4526.6200
## oproc_konkur 0.04963096 0.0499 0.06290 0.0299
## koszt_pieniadza 0.01416949 0.0138 0.02101 0.0109
## oproc_propon 0.06586651 0.0634 0.11350 0.0259
## oproc_refin 0.08370916 0.0775 0.24000 0.0300
## SD Range Skewness Kurtosis IQR
## scoring_FICO 46.580677569 250.00000 0.27005853 -0.7113702 71.000000
## kwota_kredytu 11211.386637014 95473.38000 0.87032954 1.8349262 15203.232500
## oproc_konkur 0.005794450 0.03300 -0.08879177 0.4516448 0.009000
## koszt_pieniadza 0.002618089 0.01011 0.20035865 -1.3486528 0.005162
## oproc_propon 0.020703963 0.08760 0.64076629 -0.5706685 0.034200
## oproc_refin 0.031016218 0.21000 1.54075988 3.0408174 0.036500
write.xlsx(final_stats, file = "Wyniki.xlsx", sheetName = "stat_opis_il", rowNames = TRUE)
# Ustaw układ wykresów 3/3/1
par(mfrow = c(3, 3))
# Rysowanie wykresów
for (zm in zm_ilosciowe) {
hist(Dane_projekt[[zm]],
main = paste("Histogram:", zm),
xlab = "",
col = "lightblue",
border = "black")
}
hist(oprocentowanie_refin$oproc_refin,
main = "Histogram: oproc_refin",
xlab = "",
col = "lightblue",
border = "black")
Tabele liczebności - dla kategorycznych
zm_kategotyczne <- c("grupa_ryzyka", "kod_partnera", "okres_kredytu", "typ_umowy", "akceptacja_klienta")
for (var in zm_kategotyczne) {
cat_table <- table(Dane_projekt[[var]], useNA = "ifany")
cat_prop <- prop.table(cat_table) # Częstości (proporcje)
cat_df <- data.frame(
Category = names(cat_table),
Count = as.vector(cat_table),
Proportion = as.vector(cat_prop)
)
cat("Tabela dla zmiennej:", var, "\n")
print(cat_df)
cat("\n")
}
## Tabela dla zmiennej: grupa_ryzyka
## Category Count Proportion
## 1 1 17448 0.436200
## 2 2 8265 0.206625
## 3 3 8977 0.224425
## 4 4 5310 0.132750
##
## Tabela dla zmiennej: kod_partnera
## Category Count Proportion
## 1 1 14810 0.370250
## 2 2 6243 0.156075
## 3 3 18947 0.473675
##
## Tabela dla zmiennej: okres_kredytu
## Category Count Proportion
## 1 36 6109 0.152725
## 2 48 5590 0.139750
## 3 60 19376 0.484400
## 4 66 988 0.024700
## 5 72 7937 0.198425
##
## Tabela dla zmiennej: typ_umowy
## Category Count Proportion
## 1 N 14323 0.358075
## 2 R 11298 0.282450
## 3 U 14379 0.359475
##
## Tabela dla zmiennej: akceptacja_klienta
## Category Count Proportion
## 1 0 29633 0.740825
## 2 1 10367 0.259175
Histogramy dla kategorycznych
# grupa_ryzyka
plot1 <- ggplot(Dane_projekt, aes(x = grupa_ryzyka)) +
geom_histogram(stat = "count", fill = "skyblue", color = "black") +
labs(title = "Histogram dla grupy ryzyka",
y = "Liczba obserwacji") + theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.text.x = element_text(hjust = 1, size = 12),
axis.text.y = element_text(size = 10))
## Warning in geom_histogram(stat = "count", fill = "skyblue", color = "black"):
## Ignoring unknown parameters: `binwidth`, `bins`, and `pad`
# kod_partnera
plot2 <- ggplot(Dane_projekt, aes(x = kod_partnera)) +
geom_histogram(stat = "count", fill = "yellow", color = "black") +
labs(title = "Histogram dla kodu partnera",
y = "Liczba obserwacji") + theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.text.x = element_text(hjust = 1, size = 12),
axis.text.y = element_text(size = 10))
## Warning in geom_histogram(stat = "count", fill = "yellow", color = "black"):
## Ignoring unknown parameters: `binwidth`, `bins`, and `pad`
# typ_umowy
plot3 <- ggplot(Dane_projekt, aes(x = typ_umowy)) +
geom_histogram(stat = "count", fill = "green", color = "black") +
labs(title = "Histogram dla typu umowy",
y = "Liczba obserwacji") + theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.text.x = element_text(hjust = 1, size = 12),
axis.text.y = element_text(size = 10))
## Warning in geom_histogram(stat = "count", fill = "green", color = "black"):
## Ignoring unknown parameters: `binwidth`, `bins`, and `pad`
# okres_kredytu
plot4 <- ggplot(Dane_projekt, aes(x = factor(okres_kredytu))) +
geom_bar(fill = "orange", color = "black") +
labs(title = "Histogram dla akceptacji klienta",
y = "Liczba obserwacji") +
theme_minimal() +
theme(
axis.title.x = element_blank(),
axis.text.x = element_text(hjust = 1, size = 12),
axis.text.y = element_text(size = 10)
)
# akceptacja_klienta
plot5 <- ggplot(Dane_projekt, aes(x = factor(akceptacja_klienta))) +
geom_bar(fill = "red", color = "black") +
labs(title = "Histogram dla akceptacji klienta",
y = "Liczba obserwacji") +
theme_minimal() +
theme(
axis.title.x = element_blank(),
axis.text.x = element_text(hjust = 1, size = 12),
axis.text.y = element_text(size = 10)
)
grid.arrange(plot1, plot2, plot3, plot4, ncol = 2, nrow = 2)
print(plot5)
