MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

MODELISATION DU RISQUE DE
Code

CREDIT
07/07/2024
L’objectif de ce projet est de décrire le processus de développement d’un modèle de notation de crédit à
la consommation. La modélisation de la probabilité de défaut (PD) est un concept clé pour classifier les
emprunteurs selon leur risque de défaut de paiement.

Voici les principales conclusions:

1. Le revenu plus élevé ainsi que la durée de l’activité professionnelle plus longue de l’emprunteur
réduisent le risque de défaut de paiement. Cela souligne l’importance de la stabilité financière et de
l’expérience professionnelle dans l’évaluation du risque de crédit.

2. Le taux d’endettement plus élevé entraîne une forte augmentation du risque de défaut de paiement.
Ce ratio est crucial pour évaluer la capacité de l’emprunteur à gérer ses dettes par rapport à ses
revenus.

3. Être propriétaire d’un logement diminue la probabilité de défaut de paiement, tandis qu’être locataire
l’augmente. Cette observation pourrait s’expliquer par les dépenses potentiellement moins
importantes et par le patrimoine plus solide des propriétaires par rapport aux locataires.

4. La probabilité de défaut de paiement augmente avec la dégradation des classes de solvabilité. Les
emprunteurs classés dans les catégories inférieures (D, E, F) ont un risque de défaut plus élevé
comparé à ceux classés dans les catégories supérieures (A, B, C).

5. Le taux d’intérêt plus élevé accroît considérablement le risque de défaut de paiement. Cela peut
s’expliquer par la charge financière plus importante, rendant ainsi le remboursement plus difficile.

6. Les prêts destinés à l’éducation, aux besoins médicaux, aux dépenses personnelles ou aux affaires
sont moins risqués pour les banques. En revanche, les prêts pour les travaux de rénovation et la
consolidation des dettes présentent un risque plus élevé de défaut de paiement.

Ce modèle présente une performance de classification élevée, avec une précision de 87 % pour identifier
les emprunteurs potentiels en fonction de leur risque de défaut.

Axes d’amélioration:

1. Élargir la base de données : intégrer des caractéristiques supplémentaires des emprunteurs afin de
capturer davantage de nuances dans les profils de risque.

2. Actualiser régulièrement: mettre à jour régulièrement le modèle avec de nouvelles données pour
s’adapter aux changements du marché et des comportements des emprunteurs.

3. Ajuster les seuils de classification: définir les seuils de manière à maximiser la performance du
modèle en fonction des objectifs spécifiques de la banque.

[Link] Page 1 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Donc, ce modèle actuel constitue une base solide pour la prise de décision en matière d’octroi de prêts.
Cependant, l’intégration de nouvelles données et la mise à jour continue permettront d’optimiser encore
davantage la gestion du risque de crédit et de renforcer la robustesse des prédictions.

1. Collecte des données

Hide

# Afficher le répertoire de travail courant

getwd()

[1] "/Users/patash/Documents/GitHub/Credit_scoring"

Hide

# Modifier le répertoire de travail

setwd("/Users/patash/Documents/GitHub/Credit_scoring")

Hide

# Importer le dataset
df <- [Link]("credit_risk.csv", header = TRUE, sep = ",", dec = ".")

# Structure de la dataframe
str(df)

'[Link]': 32581 obs. of 12 variables:

$ person_age : int 22 21 25 23 24 21 26 24 24 21 ...
$ person_income : int 59000 9600 9600 65500 54400 9900 77100 78956 8
3000 10000 ...
$ person_home_ownership : chr "RENT" "OWN" "MORTGAGE" "RENT" ...
$ person_emp_length : num 123 5 1 4 8 2 8 5 8 6 ...
$ loan_intent : chr "PERSONAL" "EDUCATION" "MEDICAL" "MEDICAL" ...
$ loan_grade : chr "D" "B" "C" "C" ...
$ loan_amnt : int 35000 1000 5500 35000 35000 2500 35000 35000 3
5000 1600 ...
$ loan_int_rate : num 16 11.1 12.9 15.2 14.3 ...
$ loan_status : int 1 0 1 1 1 1 1 1 1 1 ...
$ loan_percent_income : num 0.59 0.1 0.57 0.53 0.55 0.25 0.45 0.44 0.42 0.
16 ...
$ cb_person_default_on_file : chr "Y" "N" "N" "N" ...
$ cb_person_cred_hist_length: int 3 2 3 2 4 2 3 4 2 3 ...

Hide

[Link] Page 2 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Convertir le type 'loan_status' en factor

df$loan_status<- factor(df$loan_status)
str(df$loan_status)

Factor w/ 2 levels "0","1": 2 1 2 2 2 2 2 2 2 2 ...

2. Prétraitement des données

Analyse exploitoire
Hide

summary(df)

person_age person_income person_home_ownership

person_emp_length
Min. : 20.00 Min. : 4000 Length:32581
Min. : 0.00
1st Qu.: 23.00 1st Qu.: 38500 Class :character
1st Qu.: 2.00
Median : 26.00 Median : 55000 Mode :character
Median : 4.00
Mean : 27.73 Mean : 66075 Mean : 4.79
3rd Qu.: 30.00 3rd Qu.: 79200 3rd Qu.: 7.00
Max. :144.00 Max. :6000000 Max. :123.00
NA's :895
loan_intent loan_grade loan_amnt loan_int_rate
Length:32581 Length:32581 Min. : 500 Min. : 5.42
Class :character Class :character 1st Qu.: 5000 1st Qu.: 7.90
Mode :character Mode :character Median : 8000 Median :10.99
Mean : 9589 Mean :11.01
3rd Qu.:12200 3rd Qu.:13.47
Max. :35000 Max. :23.22
NA's :3116
loan_status loan_percent_income cb_person_default_on_file
0:25473 Min. :0.0000 Length:32581
1: 7108 1st Qu.:0.0900 Class :character
Median :0.1500 Mode :character
Mean :0.1702
3rd Qu.:0.2300
Max. :0.8300

cb_person_cred_hist_length
Min. : 2.000
1st Qu.: 3.000
Median : 4.000
Mean : 5.804
3rd Qu.: 8.000
Max. :30.000

[Link] Page 3 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Valeurs manquantes
Hide

[Link]("naniar")

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 2771094 bytes (2.6 MB)
==================================================
downloaded 2.6 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

library(naniar)
vis_miss(df)

Hide

[Link] Page 4 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Remplacer les valeurs manquantes

# Création d'une copie de la dataframe df

df_clean <- df

# Nombre de lignes initial dans df_clean

nrow(df_clean)

[1] 32581

Hide

# Variable person_emp_length

# Identifier les indices des valeurs NA dans la colonne 'person_emp_length'

index_NA_person_emp_length <- which([Link](df_clean$person_emp_length))
# Remplacer les valeurs NA par la médiane de 'person_emp_length'
df_clean$person_emp_length[index_NA_person_emp_length] <- median(df_clean$person_e
mp_length, [Link] = TRUE)
# Vérifier les valeurs NA restantes
sum([Link](df_clean$person_emp_length))

[1] 0

Hide

# Variable loan_int_rate
index_NA_loan_int_rate <- which([Link](df_clean$loan_int_rate))
df_clean$loan_int_rate[index_NA_loan_int_rate] <- median(df_clean$loan_int_rate, n
[Link] = TRUE)
sum([Link](df_clean$loan_int_rate))

[1] 0

Hide

# Convertir le type 'person_emp_length' en integer

df_clean$person_emp_length <- [Link](df_clean$person_emp_length)
str(df_clean$person_emp_length)

int [1:32581] 123 5 1 4 8 2 8 5 8 6 ...

Valeurs aberrantes (outliers)

Hide

[Link] Page 5 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Idéntifier les valeurs aberrantes

# Boxplots

# age
boxplot(df_clean$person_age, main = "Age")

Hide

# income
boxplot(df_clean$person_income, main = "Revenu")

[Link] Page 6 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# emp_lenght
boxplot(df_clean$person_emp_length, main = "Durée de l'activité pro")

[Link] Page 7 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_percent_income
boxplot(df_clean$loan_percent_income, main = "Ratio dette/revenu")

[Link] Page 8 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# cred_hist_length
boxplot(df_clean$cb_person_cred_hist_length, main = "Historique des antécédents de
crédit")

[Link] Page 9 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_amnt
boxplot(df_clean$loan_amnt, main = "Montant du prêt")

[Link] Page 10 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_int_rate
boxplot(df_clean$loan_int_rate, main = "Taux d'intérêt")

[Link] Page 11 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'person_income'
# Calculer les quartiles et l'IQR
Q1 <- quantile(df_clean$person_income, 0.25)
Q3 <- quantile(df_clean$person_income, 0.75)
IQR <- Q3 - Q1

# Déterminer les limites

lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR

# Identifier les indices des valeurs aberrantes

index_outlier_income <- which(df_clean$person_income < lower_bound | df_clean$pers
on_income > upper_bound)

# Afficher les indices

# index_outlier_income

# Supprimer les valeurs aberrantes de 'person_income'

df_clean <- df_clean[-index_outlier_income, ]

# Histogramme des revenus annuels après suppression des aberrations

hist(df_clean$person_income, main = "Revenu")

[Link] Page 12 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'person_age'

# Suppression des valeurs aberrantes

df_clean <- subset(df_clean, df_clean$person_age < 80)

# Histogramme des revenus annuels après suppression des aberrations

hist(df_clean$person_age, main = "Age")

[Link] Page 13 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'person_emp_length'

df_clean <- subset(df_clean, df_clean$person_emp_length < 60)

# Histogramme de la durée de l'acitivté pro

hist(df_clean$person_emp_length, main = "Durée de l'activité pro")

[Link] Page 14 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Exporter 'df_clean' en fichier csv

[Link](df_clean, file = "credit_risk_clean.csv", [Link] = FALSE)

Hide

str(df_clean)

'[Link]': 31091 obs. of 12 variables:

$ person_age : int 21 25 23 24 21 26 24 24 21 22 ...
$ person_income : int 9600 9600 65500 54400 9900 77100 78956 83000 1
0000 85000 ...
$ person_home_ownership : chr "OWN" "MORTGAGE" "RENT" "RENT" ...
$ person_emp_length : int 5 1 4 8 2 8 5 8 6 6 ...
$ loan_intent : chr "EDUCATION" "MEDICAL" "MEDICAL" "MEDICAL" ...
$ loan_grade : chr "B" "C" "C" "C" ...
$ loan_amnt : int 1000 5500 35000 35000 2500 35000 35000 35000 1
600 35000 ...
$ loan_int_rate : num 11.14 12.87 15.23 14.27 7.14 ...
$ loan_status : Factor w/ 2 levels "0","1": 1 2 2 2 2 2 2 2 2 2 ...
$ loan_percent_income : num 0.1 0.57 0.53 0.55 0.25 0.45 0.44 0.42 0.16 0.
41 ...
$ cb_person_default_on_file : chr "N" "N" "N" "Y" ...
$ cb_person_cred_hist_length: int 2 3 2 4 2 3 4 2 3 4 ...

[Link] Page 15 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Analyse univariée
Variable-cible ‘loan_status’
Hide

# Table et proportions
loan_status_table <- table(df_clean$loan_status)
proportions_loan_status <- round([Link](loan_status_table) * 100, 1)
labels <- paste(names(loan_status_table), "\n", proportions_loan_status, "%", sep
="")

# Diagramme en camembert
pie(loan_status_table, labels = labels, main = " Taux de défaut", col = c("red", "
green"))

Variables-facteurs
Hide

# Analyse des distributions des variables quantitatives

# age
hist(df_clean$person_age, main = "Age", col = "blue")

[Link] Page 16 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# income
hist(df_clean$person_income, main = "Revenu", col = "green")

[Link] Page 17 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# emp_lenght
hist(df_clean$person_emp_length, main = "Durée de l'activité pro", col = "red")

[Link] Page 18 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_amnt
hist(df_clean$loan_amnt, main = "Montant du prêt", col = "orange")

[Link] Page 19 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_int_rate
hist(df_clean$loan_int_rate, main = "Taux d'intérêt", col = "purple")

[Link] Page 20 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# loan_percent_income
hist(df_clean$loan_percent_income, main = "Ratio dette/revenu", col = "brown")

[Link] Page 21 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

#cred_hist_length
hist(df_clean$cb_person_cred_hist_length, main = "Durée des antécédents de crédits
", col = "violet")

[Link] Page 22 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Analyse des distributions des variables qualitatives

# Barplot de proportion avec valeurs

barplot_proportion <- function(variable, df_clean, title) {
table_var <- table(df_clean[[variable]])
prop_table <- [Link](table_var)
bp <- barplot(prop_table, main = title, xlab = variable, col = rainbow(length(pr
op_table)), ylim = c(0, max(prop_table) + 0.1))

# Ajouter les valeurs sur les barres

text(bp, prop_table + 0.02, round(prop_table*100, 1), cex = 0.8, pos = 3)
}

# 'home_ownership'
barplot_proportion( "person_home_ownership", df_clean, "Propriété des biens immobi
liers")

[Link] Page 23 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_intent'
barplot_proportion("loan_intent", df_clean, "Motifs de prêt")

[Link] Page 24 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# + camembert
loan_intent_table<- table(df_clean$loan_intent)
proportions_loan_intent<- round([Link](loan_intent_table) * 100, 1)
labels <- paste(names(loan_intent_table), "\n", proportions_loan_intent, "%", sep
="")
pie(loan_intent_table, labels = labels, main = "Motifs de prêt")

[Link] Page 25 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_grade'
barplot_proportion("loan_grade", df_clean, "Catégories d'emprunteurs")

[Link] Page 26 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'default_on_file'
barplot_proportion("cb_person_default_on_file",df_clean, "Défaut de paiement dans
le passé ")

[Link] Page 27 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_status'
barplot_proportion("loan_status", df_clean, "Défaut de paiement")

[Link] Page 28 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Analyse bivariée
Hide

[Link]("ggplot2")

Error in [Link] : Updating loaded packages

Hide

[Link]("gridExtra")

trying URL '[Link]

a_2.[Link]'
Content type 'application/x-gzip' length 1105778 bytes (1.1 MB)
==================================================
downloaded 1.1 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

[Link] Page 29 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

[Link]("RColorBrewer")

trying URL '[Link]

ewer_1.[Link]'
Content type 'application/x-gzip' length 53104 bytes (51 KB)
==================================================
downloaded 51 KB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

[Link]("ggplot2")

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 4967644 bytes (4.7 MB)
==================================================
downloaded 4.7 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

library(ggplot2)
library(gridExtra)
library(RColorBrewer)

Variables qualitatives
Hide

[Link] Page 30 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# BARPLOTS, test de chi deux (H0: absence de corrélation), V de Cramer [0:1]

# Convertir en factor
df_clean$person_home_ownership <- factor(df_clean$person_home_ownership, ordered =
FALSE)
df_clean$loan_intent<- factor(df_clean$loan_intent, ordered = FALSE)
df_clean$loan_grade <- factor(df_clean$loan_grade, ordered = FALSE)
df_clean$cb_person_default_on_file <- factor(df_clean$cb_person_default_on_file, o
rdered = FALSE)

# 'home_ownership'
ggplot(df_clean, aes(x = loan_status, fill = person_home_ownership)) +
geom_bar(position = "fill") +
labs(title = "Propriété des biens immobiliers et défaut de paiement",
x = "Défaut de paiement",
y = "Proportion") +
scale_fill_brewer(palette = "Set1") +
theme_minimal()

Hide

[Link] Page 31 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# 'loan_intent'
ggplot(df_clean, aes(x = loan_status, fill = loan_intent)) +
geom_bar(position = "fill") +
labs(title = "Motifs de prêt et défaut de paiement",
x = "Défaut de paiement",
y = "Proportion") +
scale_fill_brewer(palette = "Set1") +
theme_minimal()

Hide

# 'loan_grade'
ggplot(df_clean, aes(x = loan_status, fill = loan_grade)) +
geom_bar(position = "fill") +
labs(title = "Catégories d'emprunteurs et défaut de paiement",
x = "Défaut de paiement",
y = "Proportion") +
scale_fill_brewer(palette = "Set1") +
theme_minimal()

[Link] Page 32 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'default_on_file'
ggplot(df_clean, aes(x = loan_status, fill = cb_person_default_on_file)) +
geom_bar(position = "fill") +
labs(title = "Défaut de paiement dans le passé et défaut de paiement",
x = "Défaut de paiement",
y = "Proportion") +
scale_fill_brewer(palette = "Set1") +
theme_minimal()

[Link] Page 33 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Résultats des tests

results <- [Link](Variable = character(), Chi_square = numeric(), P_value = nu
meric(), Cramers_V = numeric())
variables_qualitatives <- c("person_home_ownership", "loan_intent", "loan_grade",
"cb_person_default_on_file")

for (var in variables_qualitatives) {

contingency_table <- table(df_clean[[var]], df_clean$loan_status)

# Chi-carré
chi_squared_test <- [Link](contingency_table)

# V de Cramer
cramer_v <- sqrt(chi_squared_test$statistic / (nrow(df) * (min(nrow(contingency_
table), ncol(contingency_table)) - 1)))

results <- rbind(results, [Link](Variable = var, Chi_square = chi_squared_te

st$statistic, P_value = chi_squared_test$[Link], Cramers_V = cramer_v))
}
# Trier les résultats par V de Cramer croissant
results <- results[order(-results$Cramers_V), ]
print(results)

Variable Chi_square P_value Cramers_V

[Link] Page 34 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

<chr> <dbl> <dbl> <dbl>

X-squared2 loan_grade 5342.0609 0.000000e+00 0.4049228

X-squared person_home_ownership 1807.7758 0.000000e+00 0.2355538

X-squared3 cb_person_default_on_file 999.0332 2.913519e-219 0.1751087

X-squared1 loan_intent 494.4675 1.248566e-104 0.1231932

4 rows

Les tests Chi-square indiquent une association significative entre toutes les variables qualitatives et la
variable-cible avec des niveaux de significativité très élevés (P-value << 0.05). Les valeurs de Cramers V
montrent que ‘loan_grade’ a l’effet le plus marqué sur ‘loan_status’ (30 % des clients en défaut
appartiennent à la catégorie D), suivi par ‘person_home_ownership’ (74 % des clients en défaut louent leur
logement et 23 % ont une hypothèque), ‘cb_person_default_on_file’ (70 % des clients en défaut n’ont pas
eu de défaut de paiement dans le passé), et enfin ’loan_intent.

Variables quantitatives
Hide

# BOXPLOTS, test de Kruskal-Wallis

# 'person_age'
ggplot(df_clean, aes(x = factor(loan_status), y = person_age, fill = factor(loan_s
tatus))) +
geom_boxplot() +
labs(title = "Âge et Défaut de paiement",
x = "Défaut de Paiement",
y = "Âge") +
theme_minimal()

[Link] Page 35 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'person_income'
ggplot(df_clean, aes(x = factor(loan_status), y = person_income, fill = factor(loa
n_status))) +
geom_boxplot() +
labs(title = "Revenu et Défaut de paiement",
x = "Défaut de Paiement",
y = "Revenu") +
theme_minimal()

[Link] Page 36 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'person_emp_length'
ggplot(df_clean, aes(x = factor(loan_status), y = person_emp_length, fill = facto
r(loan_status))) +
geom_boxplot() +
labs(title = "Durée de l'acticité pro et Défaut de paiement",
x = "Défaut de Paiement",
y = "Durée de l'activité pro") +
theme_minimal()

[Link] Page 37 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_amnt'
ggplot(df_clean, aes(x = factor(loan_status), y = loan_amnt, fill = factor(loan_st
atus))) +
geom_boxplot() +
labs(title = "Montant du prêt et Défaut de paiement",
x = "Défaut de Paiement",
y = "Montant du prêt") +
theme_minimal()

[Link] Page 38 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_int_rate'
ggplot(df_clean, aes(x = factor(loan_status), y = loan_int_rate, fill = factor(loa
n_status))) +
geom_boxplot() +
labs(title = "Taux d'intérêt et Défaut de paiement",
x = "Défaut de Paiement",
y = "Taux d'intérêt") +
theme_minimal()

[Link] Page 39 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'loan_percent_income'
ggplot(df_clean, aes(x = factor(loan_status), y = loan_percent_income, fill = fact
or(loan_status))) +
geom_boxplot() +
labs(title = "Ration dette/revenu et Défaut de paiement",
x = "Défaut de Paiement",
y = "Ration dette/revenu") +
theme_minimal()

[Link] Page 40 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# 'cb_person_cred_hist_length'
ggplot(df_clean, aes(x = factor(loan_status), y = cb_person_cred_hist_length, fill
= factor(loan_status))) +
geom_boxplot() +
labs(title = "Durée des antécédents de crédits et Défaut de paiement",
x = "Défaut de Paiement",
y = "Durée des antécédents de crédits") +
theme_minimal()

[Link] Page 41 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Résultats du test
results <- [Link](Variable = character(), Kruskal_Wallis = numeric(), P_value
= numeric())
variables_numeriques <- c("person_age", "person_income", "person_emp_length",
"loan_amnt", "loan_int_rate", "loan_percent_income",
"cb_person_cred_hist_length")
# test de Kruskal-Wallis
for (var in variables_numeriques) {
kruskal_test <- [Link](df_clean[[var]] ~ df_clean$loan_status)

results <- rbind(results, [Link](Variable = var, Kruskal_Wallis = kruskal_test

$statistic, P_value = kruskal_test$[Link]))
}

# Trier les résultats par la statistique de test décroissant

results <- results[order(results$Kruskal_Wallis, decreasing = TRUE), ]
print(results)

Variable Kruskal_Wallis P_valu

<chr> <dbl> <dbl

Kruskal-Wallis chi-squared5 loan_percent_income 3159.34175 0.000000e+0

Kruskal-Wallis chi-squared4 loan_int_rate 2782.63941 0.000000e+0

[Link] Page 42 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Kruskal-Wallis chi-squared1 person_income 2282.66616 0.000000e+0

Kruskal-Wallis chi-squared2 person_emp_length 286.73101 2.563616e-6

Kruskal-Wallis chi-squared3 loan_amnt 280.37173 6.231454e-6

Kruskal-Wallis chi-squared person_age 25.17319 5.240565e-0

Kruskal-Wallis chi-squared6 cb_person_cred_hist_length 11.90679 5.592981e-0

7 rows

Les tests Kruskal-Wallis constatent la liaison significative entre toutes les variables quantitatives et la
variable-cible, avec des niveaux de significativité très élevés (P-value << 0.05). Les valeurs de la statistique
Kruskal_Wallis montrent que ‘person_income’ a l’effet le plus marqué sur ‘loan_status’ (médiane des
revenus des clients en défaut de paiement est de 38K€, contrairement à celle des clients qui remboursent,
qui est de 58K€), suivi par ‘loan_int_rate’ (médiane des taux d’intérêt des clients en défaut de paiement est
de 13%, contrairement à celle des clients qui remboursent, qui est de 11,25%), ‘loan_persent_income’
(médiane des ratios dette/revenu des clients en défaut de paiement est de 23%, contrairement à celle des
clients qui remboursent, qui est de 14%).

Les variables quantitatives et qualitatives sont pertinentes pour la modélisation.

Multicolinéarité
Hide

# Corrélation entre les varianbles numériques

variables_numeriques <- df_clean[, c("person_age", "person_income", "person_e

mp_length",
"loan_amnt", "loan_int_rate", "loan_percent_income",
"cb_person_cred_hist_length")]

# Calculer la matrice de corrélation

correlation_matrix <- cor(variables_numeriques, use = "[Link]")

# Installer et charger corrplot

[Link]("corrplot")

trying URL '[Link]

_0.[Link]'
Content type 'application/x-gzip' length 3846566 bytes (3.7 MB)
==================================================
downloaded 3.7 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

[Link] Page 43 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

library(corrplot)

corrplot 0.92 loaded

Hide

# Créer la heatmap de corrélation

corrplot(correlation_matrix, method = "color", type = "upper",
[Link] = "black", [Link] = 45, [Link] = "black",
[Link] = 0.7, [Link] = 2)

Hide

# VIF
[Link]("car")

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 1710465 bytes (1.6 MB)
==================================================
downloaded 1.6 MB

[Link] Page 44 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

library(car)

Loading required package: carData

Hide

variables_explicatives <- df_clean[, c("person_age", "person_income", "person_emp_

length", "loan_amnt", "loan_int_rate", "loan_percent_income", "cb_person_cred_hist
_length")]

# Ajuster un modèle de régression logistique

modele_logistique <- glm(loan_status ~ person_age + person_income + person_emp_len

gth + loan_amnt + loan_int_rate + loan_percent_income + cb_person_cred_hist_lengt
h,
data = df_clean, family = binomial)

# Calculer les VIF

vif <- vif(modele_logistique)

# Afficher les résultats

print(vif)

person_age person_income person_emp_length

4.445905 4.503810 1.053402
loan_amnt loan_int_rate loan_percent_income
7.368024 1.081091 5.891919
cb_person_cred_hist_length
4.413746

Les valeurs du VIF (facteur d’inflation de la variance) des variables explicatives numériques sont inférieures
à 10, ce qui indique qu’il n’y a pas de multicolinéarité élevée.

Lors de l’analyse exploratoire, on a remarqué que les moyennes et les écarts-types varient
considérablement d’une variable à l’autre. Cela indique que les données ne sont pas à la même échelle. Il
faudra donc les normaliser avant de modéliser afin d’obtenir des résultats plus précis.

Normalisation des variables numériques

Hide

[Link] Page 45 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

df_clean_norm <- df_clean

# Création d'une fonction de normalisation

normalize <- function(x) {
return ((x - min(x)) / (max(x) - min(x)))
}

# Normalisation des données (répartir les valeurs entre 0 et 1 tout en gardant les
distributions originales)
for (col in names(df_clean_norm)) {
if () {
df_clean_norm[[col]] <- normalize(df_clean_norm[[col]])
}
}
head(df_clean_norm)

person_age person_income person_home_ownership person_emp_length loan_intent

<dbl> <dbl> <fctr> <dbl> <fctr>

2 0.01724138 0.04117526 OWN 0.12195122 EDUCATION

3 0.08620690 0.04117526 MORTGAGE 0.02439024 MEDICAL

4 0.05172414 0.45219258 RENT 0.09756098 MEDICAL

5 0.06896552 0.37057734 RENT 0.19512195 MEDICAL

6 0.01724138 0.04338108 OWN 0.04878049 VENTURE

7 0.10344828 0.53748419 RENT 0.19512195 EDUCATION

6 rows | 1-7 of 12 columns

Hide

# Exporter 'df_clean_norm' en fichier csv

[Link](df_clean_norm, file = "credit_risk_clean_norm.csv", [Link] = FALSE)

3. Partitionnement des données (Train, Test)

Hide

[Link] Page 46 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Données d'entraînement (80%) et de test (20%) (Division aléatoire)

seed <- 131

[Link](seed)

index_train <- sample(1:nrow(df_clean_norm), 0.8 * nrow(df_clean_norm))

train_set <- df_clean_norm[index_train, ]
test_set <- df_clean_norm[-index_train, ]

print(nrow(train_set))

[1] 24872

Hide

print(nrow(test_set))

[1] 6219

Hide

# Table de fréquence de la variable-cible 'loan_status' dans l'ensemble d'entraîne

ment
[Link](table(train_set$loan_status))

0 1
0.7731586 0.2268414

Hide

# Table de fréquence de la variable-cible 'loan_status' dans l'ensemble de test

[Link](table(test_set$loan_status))

0 1
0.7877472 0.2122528

Lors de l’analyse de la fréquence de la variable cible ‘loan_status’ dans les ensembles de données
d’entraînement et de test, on constate un déséquilibre dans la distribution des classes (77% - 23% - train,
79% - 21% - test). Pour résoudre le problème de déséquilibre de classe et améliorer la performance de
classification, on peut appliquer les techniques de rééchantillonnage ROS (Random Over Sampling) et
RUS (Random Under Sampling), puis comparer les courbes ROC et les valeurs AUC pour choisir le
mellieur jeu de données. Les méthodes de rééchantillonnage des données on applique uniquement aux
données d’entraînement. Inconvénient du ROS: il crée beaucoup de doublons d’information, ce qui peut

[Link] Page 47 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

causer des biais importants lors de l’entraînement. Inconvénient du RUS: il supprime beaucoup
d’informations. Après avoir comparé les courbes ROC et les valeurs AUC, on constate qu’il n’y a pas de
différence significative entre les trois jeux de données (AUC ROC: 0,868, AUC RUS:0,869, AUC train_set:
0,867). Par conséquent, on va utiliser le jeu de données d’origine.

4. Entraînement du modèle
Régression logistique
Hide

log_modeling <- function(train) {

model <- glm(loan_status ~ ., family = 'binomial', data = train)
return (model)
}
log_model <- log_modeling(train_set)
summary(log_model)

[Link] Page 48 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Call:
glm(formula = loan_status ~ ., family = "binomial", data = train)

Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.42885 0.12638 -27.132 < 2e-16 ***
person_age -0.13983 0.38479 -0.363 0.716314
person_income -0.80094 0.24010 -3.336 0.000850 ***
person_home_ownershipOTHER 0.39443 0.30616 1.288 0.197629
person_home_ownershipOWN -1.66639 0.11152 -14.943 < 2e-16 ***
person_home_ownershipRENT 0.81809 0.04584 17.845 < 2e-16 ***
person_emp_length -0.58954 0.22570 -2.612 0.009001 **
loan_intentEDUCATION -0.85906 0.06451 -13.318 < 2e-16 ***
loan_intentHOMEIMPROVEMENT 0.12583 0.07208 1.746 0.080858 .
loan_intentMEDICAL -0.20651 0.06099 -3.386 0.000709 ***
loan_intentPERSONAL -0.60259 0.06552 -9.197 < 2e-16 ***
loan_intentVENTURE -1.07653 0.06980 -15.423 < 2e-16 ***
loan_gradeB 0.23523 0.07158 3.286 0.001016 **
loan_gradeC 0.46440 0.10205 4.551 5.34e-06 ***
loan_gradeD 2.50240 0.12551 19.937 < 2e-16 ***
loan_gradeE 2.73360 0.16282 16.789 < 2e-16 ***
loan_gradeF 2.96751 0.24696 12.016 < 2e-16 ***
loan_gradeG 16.90361 110.58505 0.153 0.878512
loan_amnt -3.24433 0.29627 -10.951 < 2e-16 ***
loan_int_rate 1.13703 0.25862 4.396 1.10e-05 ***
loan_percent_income 10.32291 0.36977 27.917 < 2e-16 ***
cb_person_default_on_fileY 0.03047 0.05677 0.537 0.591515
cb_person_cred_hist_length -0.05305 0.28313 -0.187 0.851377
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 26635 on 24871 degrees of freedom

Residual deviance: 17144 on 24849 degrees of freedom
AIC: 17190

Number of Fisher Scoring iterations: 13

5. Inerprétation des résulatats

Variables ayant un impact significatif sur le défaut de paiement: Emprunteur: ‘revenu’ (-) ‘durée de
l’actitivté’ (-) ‘ratio dette/revenu’(+) ‘hypothèque’ (référence) ‘propriétaire’ (-) ‘locataire’ (+) ‘grade A’
(référence) ‘grade B’ (+) ‘grade C’ (+) ‘grade D’ (+) ‘grade E’ (+) ‘grade F’ (+) Prêt: ‘montant du prêt’ (-) ‘taux
d’intrérêt’ (+) ‘motif_consolidation_dette’ (référence) ‘motif_éducation’ (-) ‘motif_travaux’ (+) ‘motif_médical’
(-) ‘motif_personnel’ (-) ‘motif_business’ (-)

[Link] Page 49 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Résultats: 1. Plus le revenu et la durée de l’activité professionnelle d’un demandeur de prêt sont élevés,
moins il est probable qu’il soit en défaut de paiement. 2. Plus le ratio dette/revenu est élevé, plus il est
probable d’être en défaut de paiement. 3. Être propriétaire d’un logement diminue la probabilité d’être en
défaut de paiement, par rapport à ceux qui ont une hypothèque, tandis qu’être locataire augmente cette
probabilité. 4. Plus le taux d’intérêt est élevé, plus il est probable d’être en défaut de paiement. En
revanche, plus le montant du prêt est élevé, moins il est probable d’être en défaut de paiement. 5. Les
motifs de prêt tels que ‘éducation’, ‘médical’, ‘personnel’, et ‘business’ ont une probabilité moins
importante d’être en défaut de paiement par rapport à ‘consolidation de dette’ et ‘travaux’. 6. Être dans les
catégories B, C, D, E, ou F augmente la probabilité de défaut de paiement par rapport à la catégorie A.

Hide

# Siginicativité globale du modèle

library(car)
library(ROSE)

Loaded ROSE 0.0-4

Hide

[Link]("DMwR2")

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 3194753 bytes (3.0 MB)
==================================================
downloaded 3.0 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

library(DMwR2)

Registered S3 method overwritten by 'quantmod':

method from
[Link] zoo

Hide

[Link]("lmtest")

[Link] Page 50 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 406478 bytes (396 KB)
==================================================
downloaded 396 KB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

library(lmtest)

Loading required package: zoo

Attaching package: ‘zoo’

The following objects are masked from ‘package:base’:

[Link], [Link]

Hide

null_model <- glm(loan_status ~ 1, data = train_set, family = binomial)

# Effectuer le test du rapport de vraisemblance (Likelihood Ratio Test)
test_lr <- lrtest(log_model, null_model)
print(test_lr)

Likelihood ratio test

Model 1: loan_status ~ person_age + person_income + person_home_ownership +

person_emp_length + loan_intent + loan_grade + loan_amnt +
loan_int_rate + loan_percent_income + cb_person_default_on_file +
cb_person_cred_hist_length
Model 2: loan_status ~ 1
#Df LogLik Df Chisq Pr(>Chisq)
1 23 -8572.1
2 1 -13317.3 -22 9490.3 < 2.2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Le modèle est globalement significatif.

Hide

[Link] Page 51 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Qualité du modèle R2 de MacFadden

# Calculer les déviations nulles et proposées

[Link] <- log_model$[Link] / -2
[Link] <- log_model$deviance / -2

# Calculer le pseudo R-carré de McFadden

pseudo_r_squared_mcfadden <- 1 - ([Link] / [Link])
print(pseudo_r_squared_mcfadden)

[1] 0.3563152

Nos variables prédictives, malgré leur effet significatif, expliquent 35,6 % de la décision d’être en défaut de
paiement. Donc, pour prédire plus justement les éventuels défauts de paiement, il faut enrichir notre base
de données avec d’autres caractéristiques des emprunteurs.

Hide

# Quantifier l'impact des variables explicatives sur la probabilité de défaut: odd

s_ratios

# Obtenir les coefficients estimés du modèle

coefficients <- coef(log_model)

# Calculer les rapports de cotes en exponentiant les coefficients

odds_ratios <- exp(coefficients)

# Créer un tableau avec les noms des variables et leurs rapports de cotes
variables <- names(coefficients)
tableau_odds_ratios <- [Link](Variable = variables, OddsRatio = odds_ratios)

# Afficher le tableau des rapports de cotes

tableau_odds_ratios

Variable OddsRatio
<chr> <dbl>

(Intercept) (Intercept) 3.242429e-02

person_age person_age 8.695089e-01

person_income person_income 4.489056e-01

person_home_ownershipOTHER person_home_ownershipOTHER 1.483543e+00

person_home_ownershipOWN person_home_ownershipOWN 1.889286e-01

person_home_ownershipRENT person_home_ownershipRENT 2.266168e+00

person_emp_length person_emp_length 5.545823e-01

[Link] Page 52 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

loan_intentEDUCATION loan_intentEDUCATION 4.235585e-01

loan_intentHOMEIMPROVEMENT loan_intentHOMEIMPROVEMENT 1.134095e+00

loan_intentMEDICAL loan_intentMEDICAL 8.134141e-01

1-10 of 23 rows Previous 1 2 3 Next

Odds ratios Emprunteur: ‘revenu’ (0,45) ‘durée de l’actitivté’ (0,55) ‘ratio dette/revenu’(30421) ‘hypothèque’
(référence) ‘propriétaire’ (0,19) ‘locataire’ (2,27) ‘grade A’ (référence) ‘grade B’ (1,26) ‘grade C’ (1,59) ‘grade
D’ (12,2) ‘grade E’ (15,4) ‘grade F’ (19,4) Prêt: ‘montant du prêt’ (0,04) ‘taux d’intrérêt’ (3,12)
‘motif_consolidation_dette’ (référence) ‘motif_éducation’ (0,42) ‘motif_travaux’ (1,13) ‘motif_médical’ (0,81)
‘motif_personnel’ (0,34) ‘motif_business’ (0,55)

Résultats: 1. Si le revenu (OR=0,45 < 1) ou la durée de l’activité professionnelle (OR=0,55 < 1) augmente
d’une unité, le risque de défaut de paiement diminue. 2. Si le ratio dette/revenu (OR=30421 >> 1)
augmente d’une unité, le risque de défaut de paiement augmente fortement. 3. Être propriétaire d’un
logement (OR=0,19 <1) diminue la probabilité d’être en défaut de paiement, tandis qu’être locataire
(OR=2,27 >1) augmente cette probabilité. 4. Si le taux d’intérêt (OR =3,12 > 1) augmente d’une unité, le
risque de défaut de paiement augmente. En revanche, si le montant du prêt augmente d’une unité, le
risque diminue (OR=0,04 < 1 - proche de l’indépendance). 5. Les motifs de prêt tels que ‘éducation’
(OR=0,42 <1), ‘médical’ (OR=0,81 <1), ‘personnel’ (OR=0,34 <1), et ‘business’ (OR=0,55 <1) diminuent la
probabilité d’être en défaut de paiement. En revanche le motif ‘travaux’ augment cette probabilité
(OR=1,13 >1). 6. Être dans les catégories B, C, D, E, ou F augmente la probabilité de défaut de paiement,
la probabilité de défaut augmente avec le déclassement ‘grade B’ (OR=1,26), ‘grade C’ (OR=1,59), ‘grade
D’ (OR=12,2), ‘grade E’ (OR=15,4), ‘grade F’ (OR=19,4)

6. Evaluation et prédictions
Hide

## Courbe ROC
[Link]("pROC")

trying URL '[Link]

[Link]'
Content type 'application/x-gzip' length 1128880 bytes (1.1 MB)
==================================================
downloaded 1.1 MB

The downloaded binary packages are in

/var/folders/0x/ld7nmr854gg9f09bct0w9drh0000gn/T//RtmpTrKxUW/downloaded_packag
es

Hide

[Link] Page 53 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

library(pROC)

Type 'citation("pROC")' for a citation.

Attaching package: ‘pROC’

The following objects are masked from ‘package:stats’:

cov, smooth, var

Hide

# Prédictions
probas_train <- predict(log_model, train_set, type = "response")
probas_test <- predict(log_model, test_set, type = "response")

# Evaluation de la pérformance de classification

roc_train <- roc(response = train_set$loan_status, predictor = probas_train)

Setting levels: control = 0, case = 1

Setting direction: controls < cases

Hide

roc_test <- roc(response = test_set$loan_status, predictor = probas_test)

Setting levels: control = 0, case = 1

Setting direction: controls < cases

Hide

par(mfrow=c(1,2))
plot(roc_train, main = "Courbe ROC - Base d'Entraînement", col = "blue", [Link]
= TRUE)
plot(roc_test, main = "Courbe ROC - Base Test", col = "red", [Link] = TRUE)

[Link] Page 54 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

auc_train <- auc(roc_train)

auc_test <- auc(roc_test)

auc_table <- [Link](Base = c("Entraînement", "Test"), AUC = c(auc_train, auc_t

est))
print(auc_table)

Base AUC
<chr> <dbl>

Entraînement 0.8716333

Test 0.8674697

2 rows

La courbe ROC montre comment les taux de vrais positifs et de faux positifs varient lorsque le seuil de
classification est modifié. L’AUC est égal à 0,87 signifie que ce modèle une probabilité de 87% de
distinguer correctement une classe négative (non défaut) d’une classe positive (défaut).

Hide

[Link] Page 55 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Seuil de probabilité
# Prédire les probabilités sur la base d'entraînement
probas_train <- predict(log_model, train_set, type = "response")

# Créer une dataframe avec les probabilités prédites et les étiquettes de 'loan_st
atus'
preds_log_train <- [Link](probabilite = probas_train, loan_status = train_set$
loan_status)

# Remplacer les valeurs de 'loan_status' (0 par "Non Défaut" et 1 par "Défaut")

preds_log_train$loan_status <- factor(preds_log_train$loan_status, levels = c(0,
1), labels = c("Non Défaut", "Défaut"))
head(preds_log_train)

probabilite loan_status
<dbl> <fctr>

13730 0.009845792 Non Défaut

8379 0.144906192 Non Défaut

19986 0.210507078 Non Défaut

25431 0.013081840 Non Défaut

23500 0.172479483 Défaut

2082 0.712921812 Non Défaut

6 rows

Hide

# Créer un graphique de densité

[Link]("ggplot2")

Error in [Link] : Updating loaded packages

Hide

library(ggplot2)
ggplot(preds_log_train, aes(x = probabilite, fill = loan_status)) +
geom_density(alpha = 0.5) +
labs(title = "Densité de Probabilité Prédite - Défaut vs. Non Défaut", x = "Prob
abilité Prédite") +
scale_fill_manual(values = c("Non Défaut" = "blue", "Défaut" = "red")) +
theme_minimal() +
theme([Link] = element_blank()) + # Supprimer le titre de la légende
labs(fill = "Défaut de paiement") # Renommer la légende

[Link] Page 56 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

À partir de 0,27, la densité de défaut devient plus importante que celle de non-défaut. Donc, on peut
considérer le seuil de classification comme étant 0,3. Accuracy - le pourcentage d’instances correctement
classifiées, c’est-à-dire la somme du nombre de vrais négatifs et de vrais positifs divisée par le nombre
total des observations. Sensibilité - le pourcentage de clients en défaut de paiement (classe positive) qui
ont été classifiés comme tels par le modèle. Spésificité - le pourcentage de clients qui ne sont pas en
défauts de paiement (classe négative) et qui ont été classififiés comme tels par le modèle.

Hide

[Link] Page 57 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

# Création d'une fonction d'évaluation de modèle

model_evaluation <- function(Model, Seuil) {

predictions <- predict(Model, newdata = test_set, type = 'response')

predicted_status <- ifelse(predictions > Seuil, 1, 0)
Conf_Mat <- table(test_set$loan_status, predicted_status)
Accuracy <- (Conf_Mat[2,2] + Conf_Mat[1,1]) / nrow(test_set)
Sensitivity <- Conf_Mat[2,2] / (Conf_Mat[2,2] + Conf_Mat[2,1])
Specificity <- Conf_Mat[1,1] / (Conf_Mat[1,1] + Conf_Mat[1,2])
One_minus_spec <- 1 - Specificity

results <- list(Conf_Mat, Accuracy, Sensitivity, Specificity, One_minus_spec)

names(results) <- c('Matrice de confusion', 'Accuracy',
'Sensibilité', 'Spécificité',
'1 - Specificity')

return(results)
}
model_evaluation(log_model, 0.3)

$`Matrice de confusion`
predicted_status
0 1
0 4278 621
1 365 955

$Accuracy
[1] 0.8414536

$Sensibilité
[1] 0.7234848

$Spécificité
[1] 0.8732394

$`1 - Specificity`
[1] 0.1267606

Seuils: 0,3, 0,4, 0,5 On remarque que plus le seuil est élevé, plus le score de classification augmente, mais
la sensibilité diminue et la spécificité du modèle augmente. Seuil optimal?

Hide

# Création d'une fonction d'affichage des résultats de modèles pour divers seuils
[Link](ggplot2)

Error in [Link] : object 'ggplot2' not found

[Link] Page 58 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

library(ggplot2)
print_results <- function(model) {

# définition des seuils

seuils <- seq(0.01, 0.99, by = 0.01)

# Vecteurs vides pour stocker les métriques

acc_model <- c()
sens_model <- c()
spec_model <- c()
one_minus_spec_model <- c()

for (i in seuils) {
r <- model_evaluation(model, i)
acc_model <- append(acc_model, r[['Accuracy']])
sens_model <- append(sens_model, r[['Sensibilité']])
spec_model <- append(spec_model, r[['Spécificité']])
one_minus_spec_model <- append(one_minus_spec_model, r[['1 - Specificit
y']])
}

# Dataframe des métriques pour divers seuils

resultats <- [Link](cbind(seuils, acc_model, sens_model, spec_model, one_m
inus_spec_model))

# Graphique montrant les métriques pour différents seuils

plots <- ggplot() +
geom_line(data=resultats, aes(x=seuils, y=acc_model, colour="re
d")) +
geom_line(data=resultats, aes(x=seuils, y=sens_model,colour="gree
n")) +
geom_line(data=resultats, aes(x=seuils, y=spec_model,colour="blu
e")) +
labs(x = 'Seuil', y = 'Score') +
scale_color_discrete(name = "Métriques", labels = c("Accuracy", "S
ensitivity", "Specificity"))

# Courbe ROC
roc_curve <- ggplot() +
geom_line(data=resultats, aes(x=one_minus_spec_model, y=sens_m
odel)) +
labs(x = '1 - Specificity', y = 'Sensitivity')

# Résultats
all_results <- list(resultats, plots, roc_curve)
names(all_results) <- c('Metrics', 'Plot', 'ROC Curve')

return (all_results)

[Link] Page 59 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Métriques de log_model pour divers seuils

head(print_results(log_model)[['Metrics']])

… seuils acc_model sens_model spec_model one_minus_spec_model

<dbl> <dbl> <dbl> <dbl> <dbl>

1 0.01 0.2614568 0.9977273 0.0630741 0.9369259

2 0.02 0.3402476 0.9893939 0.1653399 0.8346601

3 0.03 0.4063354 0.9780303 0.2522964 0.7477036

4 0.04 0.4608458 0.9606061 0.3261890 0.6738110

5 0.05 0.5079595 0.9431818 0.3906920 0.6093080

6 0.06 0.5430133 0.9242424 0.4402939 0.5597061

6 rows

Hide

tail(print_results(log_model)[['Metrics']])

seuils acc_model sens_model spec_model one_minus_spec_model

<dbl> <dbl> <dbl> <dbl> <dbl>

94 0.94 0.8036662 0.08030303 0.9985711 0.0014288630

95 0.95 0.8014150 0.06742424 0.9991835 0.0008164932

96 0.96 0.7993247 0.05681818 0.9993876 0.0006123699

97 0.97 0.7956263 0.03939394 0.9993876 0.0006123699

98 0.98 0.7935359 0.02954545 0.9993876 0.0006123699

99 0.99 0.7908024 0.01666667 0.9993876 0.0006123699

6 rows

Hide

# Graphique montrant les Métriques de log_model pour divers seuils

print_results(log_model)[['Plot']]

[Link] Page 60 sur 62

MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

La nature croissante du score de classification à mesure que le seuil augmente est une observation
courante pour les modèles de régression logistique, surtout en présence de classes déséquilibrées,
comme dans la modélisation du risque de crédit (meilleur seuil = 0,5 pour des classes équlibrées). En ce
qui concerne la sensibilité et la spécificité, on constate qu’à mesure que le seuil augmente, la sensibilité
diminue (linéaire?) tandis que la spécificité augmente, ce qui est typique pour tous les algorithmes de
classification. Le choix d’un seuil optimal est crucial, car il modifie non seulement les métriques de
performance du modèle, mais aussi les décisions concernant l’octroi de crédit aux nouveaux demandeurs.
Ce seuil détermine si la banque accordera ou non un prêt à un client potentiel. Le meilleur seuil pour
classifier les prédictions d’un modèle peut souvent être déterminé en identifiant le point d’intersection
entre la courbe de Sensibilité (True Positive Rate) et celle de Spécificité (True Negative Rate) sur la courbe
ROC (Receiver Operating Characteristic). Ce point d’intersection correspond généralement au seuil où le
modèle équilibre au mieux la sensibilité et la spécificité, optimisant ainsi la performance globale du
modèle. Cependant, il est également crucial pour une banque (ou toute autre entité utilisant un modèle de
classification) d’évaluer l’impact de ce seuil sur ses décisions de prêt. Le choix du seuil peut avoir des
implications importantes sur la gestion du risque de crédit et sur les performances financières globales.
Par conséquent, il est recommandé d’adapter périodiquement ce seuil en fonction des nouvelles données
disponibles, des changements dans les comportements des emprunteurs et des objectifs spécifiques de
l’institution financière. En résumé, bien que le point d’intersection des courbes Sensibilité et Spécificité sur
la courbe ROC soit souvent considéré comme le meilleur seuil initial, il est essentiel de prendre en compte
les implications pratiques et stratégiques de ce choix pour optimiser la gestion du risque et améliorer
continuellement les performances du modèle.

Code complémentaire
Hide
[Link] Page 61 sur 62
MODELISATION DU RISQUE DE CREDIT 12/07/2024 19:20

Hide

# Seuil
seuil <- 0.3

# Conversion des probabilités en résultats (0 ou 1) de la variable 'loan_status'

preds_log_test <- predict(log_model, newdata = test_set, type = 'response')
preds_status_test <- ifelse(preds_log_test > seuil, 1, 0)

# Matrice de confusion
conf_mat <- table(test_set$loan_status, preds_status_test)
conf_mat

preds_status_test
0 1
0 4278 621
1 365 955

Hide

# Composants de la matrice de confusion

TP <- conf_mat[2, 2]
TN <- conf_mat[1, 1]
FP <- conf_mat[1, 2]
FN <- conf_mat[2, 1]

# Score de classification
accuracy <- (TP+TN)/nrow(test_set)
accuracy

[1] 0.8414536

Hide

# Spécificité du modèle
specificity <- TN/(TN + FP)
specificity

[1] 0.8732394

[Link] Page 62 sur 62