projet data

Author

TRA BI

Published

December 26, 2024

1 📚 Introduction

1.1 🌱 Contexte

Une compagnie d’assurances souhaite mettre à profit sa base de données clients afin de diversifier ses activités. Pour ce faire, elle contacte ses nouveaux assurés pour leur proposer de souscrire à une assurance auto. Un premier test a déjà été mis en place sur quelques dizaines de milliers de nouveaux assurés . Durant cette campagne marketing, des données ont été récupérées et structurées pour savoir si la personne était effectivement intéressée par une assurance automobile, ou non.

L’équipe actuariat doit maintenant créer un modèle de prédiction à partir de cette base pour déterminer si la personne contactée sera intéressée par la souscription d’une assurance auto.

1.2 📑 définition du problème

Le but est de cibler avec un modèle de machine learning les personnes les plus susceptibles d’être intéressées par une assurance auto pour leur proposer des offres personnalisées.

1.2.1 Dictionnaire de données

Description des variables
Variable	Définition
Gender	Genre de l’assuré
Age	Âge de l’assuré (en années)
Driving_License	0 : l’assuré n’a pas de permis de conduire 1 : l’assuré a un permis de conduire
Region_Code	Code de la région de l’assuré
Previously_Insured	1 : l’assuré a déjà une assurance auto 0 : l’assuré n’a pas encore d’assurance auto
Vehicle_Age	Âge du véhicule (en années)
Vehicle_Damage	1 : l’assuré a déjà eu un sinistre automobile 0 : l’assuré n’a jamais eu de sinistre automobile
Annual_Premium	Valeur de la prime annuelle (en euros)
Policy_Sales_Channel	Code du canal de communication avec l’assuré (e.g. email, téléphone, en personne)
Vintage	Nombre de jours depuis que l’assuré a un contrat avec la compagnie
Response	1 : l’assuré est intéressé 0 : l’assuré n’est pas intéressé

1.2.2 importation de la base de donnée

Données d’entraînement
id	Gender	Age	Driving License	Region Code	Previously Insured	Vehicle Age	Vehicle Damage	Annual Premium	Policy Sales Channel	Vintage
1	Female	24	1	47	1	< 1 Year	No	28251	152	281
2	Male	42	1	50	0	1-2 Year	Yes	27436	124	124
3	Male	51	0	41	0	> 2 Years	Yes	37628	124	241
4	Male	49	1	46	0	1-2 Year	No	37856	124	169
5	Male	68	1	28	1	1-2 Year	No	29144	26	126

Données de test
id	Gender	Age	Driving License	Region Code	Previously Insured	Vehicle Age	Vehicle Damage	Annual Premium	Policy Sales Channel	Vintage
1	Male	44	1	28	0	> 2 Years	Yes	40454	26	217
2	Female	60	1	33	0	1-2 Year	Yes	32363	124	102
3	Male	30	1	30	0	< 1 Year	Yes	24550	124	45
4	Female	26	1	30	1	< 1 Year	No	31136	152	186
5	Female	29	1	15	1	< 1 Year	No	32923	152	34

2 🔍 Analyse exploratoire des données

Application Shiny

Pour ce projet, nous avons créé un outil d’analyse interactif conçu à la fois pour faciliter la compréhension de la base de données et pour un usage commercial par les équipes métiers.

📌 Le but ici est d’en savoir plus sur les données et sur nos modèles.

str(train)

'data.frame':   50000 obs. of  12 variables:
 $ id                  : int  1 2 3 4 5 6 7 8 9 10 ...
 $ Gender              : chr  "Female" "Male" "Male" "Male" ...
 $ Age                 : int  24 42 51 49 68 94 40 23 49 23 ...
 $ Driving_License     : int  1 1 0 1 1 0 1 1 1 1 ...
 $ Region_Code         : int  47 50 41 46 28 28 28 46 28 45 ...
 $ Previously_Insured  : int  1 0 0 0 1 0 0 0 0 1 ...
 $ Vehicle_Age         : chr  "< 1 Year" "1-2 Year" "> 2 Years" "1-2 Year" ...
 $ Vehicle_Damage      : chr  "No" "Yes" "Yes" "No" ...
 $ Annual_Premium      : int  28251 27436 37628 37856 29144 37712 3857100 23462 39051 13052 ...
 $ Policy_Sales_Channel: int  152 124 124 124 26 26 124 152 124 152 ...
 $ Vintage             : int  281 124 241 169 126 268 186 63 78 15 ...
 $ Response            : int  0 0 0 0 0 0 0 0 0 0 ...

Il y a 50000 observations dans le jeu de données et chaque observation a un identifiant unique. Comme son nom l’indique nous pouvons donc utiliser la variable id comme identifiant unique pour chaque observation mais elle ne nous serviras pas dans le modèles.

train <- train %>% dplyr::select(-c("id"))

dim(test)

[1] 30000    11

remarque

On observe que la variable Response est déséquilibrée. En effet, la classe 1 est sous-représentée par rapport à la classe 0.

cela signifie qu’on obtient 75,35 % de précision juste en prédisant toujours la classe majoritaire 0.

Cela peut poser problème lors de la modélisation, car le modèle peut avoir du mal à prédire la classe minoritaire. Nous devrons donc prendre en compte ce déséquilibre lors de la modélisation.

sum(is.na(train))

[1] 0

sum(is.na(test))

[1] 0

remarque

Il n’y a pas de valeur manquante dans notre base de donnée train et test

2.1 📝 Résumé des variables catégorielles

Observations	n	Percentage (%)
Driving_License
0	8897	17.79 %
1	41103	82.21 %
Previously_Insured
0	34902	69.8 %
1	15098	30.2 %
Response
0	37676	75.35 %
1	12324	24.65 %
Vehicle_Age
1-2 Year	30055	60.11 %
< 1 Year	17123	34.25 %
> 2 Years	2822	5.64 %
Gender
Female	21685	43.37 %
Male	28315	56.63 %
Vehicle_Damage
No	16698	33.4 %
Yes	33302	66.6 %
Note: Ce tableau présente la répartition des observations par variable.

remarque

On remarque que chaque modalité des variables qualitatives est bien représentée dans le jeu de données. Cela signifie que nous avons suffisamment d’observations pour chaque catégorie, ce qui est important pour l’analyse et la modélisation.

2.2 📊 analyses visuelles des variables catégorielles

remarque

Les assurés qui n’ont pas de permis de conduire ne sont pas intéressés par l’assurance auto (Figure 2).

La quasi totalité des assurés ayant déjà eu une assurance ne sont pas intéressés par l’assurance auto (Figure 3).

On remarque que plus la voiture est vielle, plus ses propriétaires sont intéressés par l’assurance auto (Figure 4).

Les hommes ont 5% de chance supplémentaire d’accepter l’assurance auto (voir Figure 5).

La quasi-totalité des assurés ayant des voitures neuves ne sont pas intéressés par l’assurance auto(Figure 6).

On remarque que la repartition des variables est la même dans la base train et test pour les variables Vehicle_Damage, Gender, Vehicle_Age, Driving_License et Previously_Insured.

2.2.1 `Region_Code`

train$Region_Code <- as.factor(train$Region_Code)
length(levels(train$Region_Code))

[1] 53

Il y a 53 régions différentes dans le jeu de données, ça fait beaucoup trop de modalité. Certaines seront forcément peu représentées

Les modalités les moins représentées de Region_Code
Region_Code	Nombre d'observations	Pourcentage(%)
51	32	0.064
52	36	0.072
42	69	0.138
44	87	0.174
22	146	0.292

Comme nous ne pouvons integrer dans nos modèles des modalités avec une frequence de 0.064%, nous allons donc chercher un seuil de fréquence en dessous duquel nous allons regrouper les modalités.

2.2.1.1 choix du seuil optimal de regroupement

Nous allons regrouper les régions les moins fréquentées (inférieur à 1%) dans la base combinée en une seule région “Autre_region”.

combined_data$Region_Code <- as.factor(combined_data$Region_Code)
combined_data$Region_Code <- fct_lump(combined_data$Region_Code, prop = 0.01)
levels(combined_data$Region_Code)[levels(combined_data$Region_Code) == "Other"] <- "Autre_region"

# Séparer à nouveau en train et test
train <- combined_data[combined_data$dataset == "train", ]
test <- combined_data[combined_data$dataset == "test", ]

# Supprimer la colonne 'dataset' des deux jeux de données
train$dataset <- NULL
test$dataset <- NULL
train$Response <- Response

length(levels(train$Region_Code))

[1] 26

conclusion

on se retrouve donc avec 26 modalités chacune correctement représentée dans le jeu de données.

2.2.2 `Policy_Sales_Channel`

la variable Policy_Sales_Channel n’est pas vraiment une variable numérique. c’est une variable à étiquette dont les étiquettes représentent une catégorie de canal de vente(email, téléphone, en personne, …).

train$Policy_Sales_Channel <- as.factor(train$Policy_Sales_Channel)
length(levels(train$Policy_Sales_Channel))

[1] 126

cette variable a 126 modalités. Nous allons la convertir en variable catégorielle en regroupant les modalités les moins fréquentes dans une seule modalité.

Les 5 modalités les moins représentées de Policy_Sales_Channel
Policy_Sales_Channel	Nombre d'observations	Pourcentage(%)
100	1	0.002
101	1	0.002
115	1	0.002
117	1	0.002
123	1	0.002

2.2.2.1 choix du seuil optimal de regroupement

je vais choisir de les regroupper à partir de 1% fréquence dans une seule modalité “Autre”

Response <- train$Response
train$dataset <- "train"
test$dataset <- "test"
combined_data <- rbind(train %>% dplyr::select(-c("Response")), test)

combined_data$Policy_Sales_Channel <- as.factor(combined_data$Policy_Sales_Channel)
combined_data$Policy_Sales_Channel <- fct_lump(combined_data$Policy_Sales_Channel, prop = 0.01)
levels(combined_data$Policy_Sales_Channel)[levels(combined_data$Policy_Sales_Channel) == "Other"] <- "Autre"

# Séparer à nouveau en train et test
train <- combined_data[combined_data$dataset == "train", ]
test <- combined_data[combined_data$dataset == "test", ]

# Supprimer la colonne 'dataset' des deux jeux de données
train$dataset <- NULL
test$dataset <- NULL
train$Response <- Response

conclusion

on se retrouve avec une variable catégorielle avec 10 modalités. chacune est correctement représentée dans le jeu de données.

Nous avons converti les variables Region_Code, Policy_Sales_Channel, en variables catégorielles en regroupant les modalités les moins fréquentes dans une seule modalité.

2.3 📝 Résumé des variables numériques

Résumé des variables numériques des données
Var2	Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
Age	20.00	27.00	40.00	42.28	51.00	139.00
Annual_Premium	2630	23830	31454	143660	38611	4994500
Vintage	10.0	84.0	160.0	224.6	236.0	5960.0

remarque

Age : La valeur maximum de 139 est probablement une valeur aberrante puisqu’elle dépasse de loin le 3e quartile.
Annual_Premium : Le maximum de 4 994 500 est bien au-dessus du 3e quartile, indiquant la présence de valeurs extrêmes.
Vintage : La valeur maximum de 5960 est également élevée comparativement aux autres.

2.4 📊 analyses visuelles des variables numériques

2.4.1 `Vintage`

Histogramme de Vintage dans la base train

Histogramme de Vintage dans la base test

Attention

Nous avons essayé de convertir la variable Vintage en mois, mais cela a réduit la performance des modèles. Nous essayerons donc d’autres méthodes.

max(test$Vintage)

[1] 299

Nous allons considérer les valeurs de Vintage dans la base train qui ont une valeur supérieure à 350(Oui, on a décidé de majorer la valeur maximale de Vitage dans la base test par une valeur raisonnable, il en sera de même pour les autres) comme des valeurs aberrantes et les enlever de notre base de données.

Ce qui représente 3,9 % de la variable Vintage dans le train. Nous allons donc les retirer de la base train.

La variable Vintage dans la base train devient

la distribution de Vintage est maintenant plus homogène et ressemble à celle de la base test.

2.4.1.1 `Age`

max(test$Age)

[1] 83

Nous allons considérer les valeurs de Age dans la base train qui ont une valeur supérieure à 90 comme des valeurs aberrantes et les enlever de notre base de données

Ce qui représente 2,4 % de la variable Age dans le train. Nous allons donc les retirer de la base train.

La variable Age dans la base train devient

la distribution de Vintage est maintenant plus homogène et ressemble à celle de la base test.

2.4.2 `Annual_Premium`

Histogramme de Annual_Premium dans la base train

Histogramme de Annual_Premium dans la base test

Les 3 valeurs qui sont les plus fréquentes dans Annual_Premium
Annual_Premium	n
2630	9315
263000	444
45179	11

Attention

Ça pourrait être une bonne idée de vouloir convertir la variable Annual_Premium en log(Annual_Premium) pour réduire l’effet des valeurs extrêmes comme 2630, mais étrangement ça réduit la performance des modèles.

max(test$Annual_Premium)

[1] 49998

Nous allons considérer les valeurs de Annual_Premium dans la base train qui ont une valeur supérieure à 50998 comme des valeurs aberrantes et les enlever de notre base de données.

Ce qui représente 4,3 % de la variable Annual_Premium dans le train. Nous allons donc les retirer de la base train.

La variable Annual_Premium dans la base train devient :

la distribution de Vintage est maintenant plus homogène et ressemble à celle de la base test.

Vintage Age et Annual_Premium avec présence des valeurs abérantes
Modeles	Métriques
Modeles	F1	Recall	Precision	AUC
CART	0.6576606	0.7529172	0.5838001	0.7898788
Régression Logistique	0.6511057	0.7362475	0.5836147	0.7833962
Random Forest	0.6469021	0.7193925	0.5876835	0.7782849

Vintage Age et Annual_Premium avec absence des valeurs aberrantes
Modeles	Métriques
Modeles	F1	Recall	Precision	AUC
CART	0.6262943	0.6666049	0.5905809	0.7587625
Régression Logistique	0.6429298	0.7023523	0.5927779	0.7733499
Random Forest	0.6487773	0.7321726	0.5824370	0.7814185

conclusion

Nous pouvons remarqué qu’il y a eu une nette amélioration des performances des modèles quand on retire les valeurs abérantes de nos variables Vintage, Age et Annual_Premium. Dans la detection des données abérantes, nous avons identifier que notre algorithme de machine learning risquait d’etre entrainé sur des valeur de Age, Vintage et Annual_Premium élevé alors qu’il va être appliqué à des valeurs plus faibles.

Au regards du contexte, nous allons enlevé les valeurs abérantes.

train <- train %>% filter(Vintage <= 350 & Age <= 90 & Annual_Premium <= 50998)

2.5 ⚖️ Ensemble de données déséquilibré

remarque

Dans Figure 1 , on observe que la classe positive représente 24,6% des données. La proportion est encore très faible, je considère qu’elle est déséquilibrée.

Pour résoudre le problème du déséquilibre des classes, il existe deux grandes catégories de techniques, l’under-sampling et l’over-sampling.

Nous choisirons dans notre cas d’utiliser la technique de suréchantillonnage(l’over-sampling), car nous disposons d’une petite base de données, et nous ne voulons pas perdre de l’information dans le processus.

SMOTE est une technique de suréchantillonnage qui génère des exemples synthétiques en interpolant les points existants. Mais le SMOTE classique ne permet pas de traiter les variables catégorielles. Pour traiter nos données mixtes, nous allons utiliser une variante de SMOTE : le SMOTE-NC, pour SMOTE-Nominal Continuous.

Pour mesurer l’impact de l’over-sampling sur la performance de nos modèles, nous avons effectué :

une première série de modèles que nous avons entraînée sur train_data, puis nous avons évalué sur test_data(?@tbl-train_data) .
une seconde série de modèles que nous avons entraînée sur smotenc_data, puis les avons évalué sur test_data(?@tbl-smotenc)

table(train_data$Response)


Négatif Positif 
  16883    5467

Pour des questions de confiance, j’ai préféré faire ce calcul avec Python. Car la librairie RSBID de R qui permet de faire cette opération est trop peu documentée.

Je n’ai pas parfaitement équilibré les données, pour éviter une surreprésentation des données synthétiques. Donc on obtient:

table(smotenc_data$Response)


Négatif Positif 
  16883   11818

Nous allons chercher à comparer les performances des modèles sur les deux ensembles de données, simple et équilibré.

results <- compare_models_version_2(train_data, smotenc_data, test_data)

Modèles avec données déséquilibrés
Modeles	Métriques
Modeles	F1	Recall	Precision	AUC
CART	0.6279674	0.6628864	0.5965432	0.7588554
Régression Logistique	0.6436763	0.7084324	0.5897670	0.7744318
Random Forest	0.6458368	0.7164807	0.5878733	0.7769159

Modèles avec données équilibrées
Modeles	Métriques
Modeles	F1	Recall	Precision	AUC
CART	0.6789328	0.8774465	0.5536704	0.8241998
Régression Logistique	0.6784702	0.8972014	0.5454849	0.8275618
Random Forest	0.6745873	0.8931772	0.5419534	0.8243651

2.5.1 analyses de la déformation des données par oversampling

Finalement, la methode de suréchantillonnage a permis d’améliorer les performances des modèles sans trop modifier la constitution des données.

write.csv(train, file = "data/data_for_python2.csv", row.names = FALSE)

Avant de passer aux modèles,

Vehicle_Age est une variable qualitative ordonnée. Nous allons donc la transformer en variable numérique en lui attribuant des valeurs ordinales.

train$Vehicle_Age <- case_when(
  train$Vehicle_Age == "< 1 Year" ~ 5,
  train$Vehicle_Age == "1-2 Year" ~ 10,
  train$Vehicle_Age == "> 2 Years" ~ 15
)

3 Modèles

3.1 CART

Pour éviter le sur-apprentissage, nous déterminons le meilleur sous-arbre en équilibrant adéquation et prévision via le paramètre de complexité cp.

Pour une valeur fixe de cp, l’estimateur final optimise un critère coût-complexité. Nous explorons une grille de valeurs pour cp et utilisons une validation croisée à 3 folds pour évaluer les performances.

\(\alpha \to \infty\): le modèle sélectionné est la racine.
\(\alpha \to 0\) : le modèle sélectionné est l’arbre maximal.


=== Métriques de Performance du Modèle ===

📈 Précision :   75.09 % (proportion de prédictions positives correctes)
🔍 Rappel :      90.58 % (proportion de véritables positifs correctement identifiés)
⚖️ F1 Score :    82.11 % (moyenne harmonique de la précision et du rappel)
✅ Exactitude :  83.75 % (proportion totale de prédictions correctes)
📊 Spécificité : 78.96 % (proportion de véritables négatifs correctement identifiés (TN / (TN + FP)))
❌ Valeur prédictive négative : 92.29 % (proportion de véritables négatifs parmi les prédictions négatives (TN / (TN + FN)))

Par défaut, caret utilise un seuil de 0.5 pour classer les probabilités.

seuil en fonction de la précision et du recall

3.2 Régression logistique

La régression logistique est un modèle de régression utilisé pour prédire la probabilité d’un événement binaire (deux classes).

L’objectif de l’Elastic Net est de minimiser la fonction de coût suivante :

\[ L(\beta) = \frac{1}{N} \sum_{i=1}^{N} \left( y_i - \mathbf{x_i}^\top \beta \right)^2 + \lambda \left( (1 - \alpha) \sum_{j=1}^{p} \beta_j^2 + \alpha \sum_{j=1}^{p} \|\beta_j\| \right) \]

où :

Alpha : Ce paramètre contrôle le type de régularisation appliquée dans le modèle.

Si α = 0 : On obtient une régression Ridge, où tous les coefficients sont pénalisés de manière égale. Dans ce cas, le paramètre lambda impose une pénalisation basée sur la norme L2, ce qui aide à limiter la variance des coefficients.
- Lorsque λ → 0, on revient à l’estimateur des moindres carrés ordinaires (OLS).
- Lorsque λ → ∞, l’estimateur Ridge tend vers 0, ce qui réduit considérablement les coefficients.
Si α = 1 : On utilise une régression Lasso, qui a pour effet de contraindre certains coefficients à zéro, facilitant ainsi la sélection de variables. Ici, lambda pénalise avec la contrainte de norme L1, permettant de retenir certains coefficients tout en forçant les autres à être nuls.
- Lorsque λ → 0, on retrouve à nouveau l’estimateur OLS, et un faible lambda produit un modèle plus complexe avec moins de régularisation.
- Lorsque λ → ∞, l’estimateur Lasso tend également vers 0, et un grand lambda entraîne un modèle plus simple avec des coefficients proches de zéro (forte régularisation).
Pour des valeurs de α entre 0 et 1 : On utilise une combinaison des deux techniques, connue sous le nom d’Elastic Net.

Lambda : Ce paramètre contrôle l’intensité de la régularisation, déterminant la force de la pénalisation appliquée aux coefficients du modèle.


=== Métriques de Performance du Modèle ===

📈 Précision :   70.26 % (proportion de prédictions positives correctes)
🔍 Rappel :      97.92 % (proportion de véritables positifs correctement identifiés)
⚖️ F1 Score :    81.81 % (moyenne harmonique de la précision et du rappel)
✅ Exactitude :  82.07 % (proportion totale de prédictions correctes)
📊 Spécificité : 70.98 % (proportion de véritables négatifs correctement identifiés (TN / (TN + FP)))
❌ Valeur prédictive négative : 97.99 % (proportion de véritables négatifs parmi les prédictions négatives (TN / (TN + FN)))

Courbe ROC pour le modèle de Régression Logistique

3.3 Random Forest

Le tuning des hyperparamètres d’un modèle Random Forest est essentiel pour maximiser ses performances prédictives. Dans ce projet, nous avons ciblé trois paramètres clés :

mtry : le nombre de variables sélectionnées aléatoirement à chaque nœud de l’arbre (paramètre nbVar).
maxnodes : le nombre maximum de nœuds pour chaque arbre.
ntree : le nombre total d’arbres dans la forêt (fixé à 300 pour cette étude).

Pour les meilleurs paramètres de nbVar et de maxnodes, nous allons tuner le nombre d’arbres dans la forêt.


=== Métriques de Performance du Modèle ===

📈 Précision :   73.05 % (proportion de prédictions positives correctes)
🔍 Rappel :      93.61 % (proportion de véritables positifs correctement identifiés)
⚖️ F1 Score :    82.06 % (moyenne harmonique de la précision et du rappel)
✅ Exactitude :  83.15 % (proportion totale de prédictions correctes)
📊 Spécificité : 75.83 % (proportion de véritables négatifs correctement identifiés (TN / (TN + FP)))
❌ Valeur prédictive négative : 94.43 % (proportion de véritables négatifs parmi les prédictions négatives (TN / (TN + FN)))

probabilities <- predict(model, train, type = "prob")[, "Positif"]
plot_roc_curve(train$Response, probabilities)

3.4 Gradient Boosting

Gradient Boosting est une méthode d’apprentissage supervisé qui combine plusieurs modèles faibles (par exemple, des arbres de décision) pour créer un modèle fort. Contrairement à un modèle comme Random Forest, où les arbres sont construits indépendamment, dans le Gradient Boosting, les arbres sont construits séquentiellement. Chaque nouvel arbre corrige les erreurs des arbres précédents, en minimisant une fonction de perte à l’aide d’un algorithme de gradient.

Pour optimiser les performances d’un modèle de Gradient Boosting, les principaux hyperparamètres à considérer sont :

n.trees : Nombre total d’arbres dans le modèle. Un nombre élevé peut améliorer la performance, mais augmente également le risque d’overfitting.
interaction.depth : Profondeur maximale des arbres. Contrôle la complexité de chaque arbre. Plus la profondeur est grande, plus l’arbre peut capturer des interactions complexes entre les variables.
shrinkage : Taux d’apprentissage (learning rate), qui contrôle la contribution de chaque arbre au modèle final. Plus ce taux est faible, plus l’entraînement nécessite un plus grand nombre d’arbres pour obtenir des performances optimales ; le modèle est donc lent et précis. Plus ce taux est élevé, le modèle converge rapidement, mais peut surajuster si combiné avec un nombre élevé d’arbres.
n.minobsinnode : Nombre minimal d’observations par nœud terminal d’un arbre. Ce paramètre contrôle la taille minimale des feuilles.

library(gbm)
library(caret)

params <- expand.grid(
  n.trees = c( 1000, 1500, 2000),
  interaction.depth =  seq(3, 6, 1),
  shrinkage = seq(0.001, 0.3, 0.01),
  n.minobsinnode = seq(5, 30, 7),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

k <- 3
set.seed(123)
folds <- createFolds(train$Response, k = k, list = TRUE)

params$f1 <- sapply(1:nrow(params), function(i) {
  
  # Récupérer les valeurs des hyperparamètres
  n.trees_value <- params$n.trees[i]
  interaction.depth_value <- params$interaction.depth[i]
  shrinkage_value <- params$shrinkage[i]
  n.minobsinnode_value <- params$n.minobsinnode[i]
  
  # Calculer les F1-scores pour chaque pli
  f1_scores <- sapply(1:k, function(j) {
    
    # Séparer les données d'entraînement et de validation
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    
    # Entraîner le modèle gbm
    gbm_model <- gbm(
      Response ~ ., data = train_fold,
      distribution = "bernoulli",
      n.trees = n.trees_value,
      interaction.depth = interaction.depth_value,
      shrinkage = shrinkage_value,
      n.minobsinnode = n.minobsinnode_value,
      verbose = FALSE
    )
    
    # Faire des prédictions
    predictions <- predict(gbm_model, newdata = valid_fold, n.trees = n.trees_value, type = "response")
    predicted_class <- ifelse(predictions > 0.5, 1, 0)  # Prédiction en binaire
    
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predicted_class <- factor(predicted_class)
    
    # Calculer la matrice de confusion et le F1-score
    cm <- confusionMatrix(predicted_class, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    
    return(f1)
  })
  
  # Retourner le F1-score moyen pour les k plis
  return(mean(f1_scores))
})


best_params <- params[which.max(params$f1), ] 
print(best_params)

3.5 XGBoost

library(xgboost)
library(caret)
library(data.table)


params <- expand.grid(
  nrounds = c(1000, 1500, 2000),
  max_depth = seq(3, 6, 1),
  eta = seq(0.001, 0.3, 0.01),
  min_child_weight = seq(5, 30, 7),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)


k <- 3
set.seed(123)
folds <- createFolds(train$Response, k = k, list = TRUE)

params$f1 <- sapply(1:nrow(params), function(i) {
  
  # Retrieve hyperparameter values
  nrounds_value <- params$nrounds[i]
  max_depth_value <- params$max_depth[i]
  eta_value <- params$eta[i]
  min_child_weight_value <- params$min_child_weight[i]
  
  # Compute F1 scores for each fold
  f1_scores <- sapply(1:k, function(j) {
    
    # Split data into training and validation
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    
    # Prepare data for XGBoost
    dtrain <- xgb.DMatrix(data = as.matrix(train_fold[, -which(names(train_fold) == "Response")]),
                          label = train_fold$Response)
    dvalid <- xgb.DMatrix(data = as.matrix(valid_fold[, -which(names(valid_fold) == "Response")]),
                          label = valid_fold$Response)
    
    # Train the XGBoost model
    xgb_model <- xgb.train(
      params = list(
        max_depth = max_depth_value,
        eta = eta_value,
        min_child_weight = min_child_weight_value,
        objective = "binary:logistic"
      ),
      data = dtrain,
      nrounds = nrounds_value,
      verbose = 0
    )
    
    # Make predictions
    predictions <- predict(xgb_model, newdata = dvalid)
    predicted_class <- ifelse(predictions > 0.5, 1, 0)
    
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predicted_class <- factor(predicted_class, levels = c(0, 1))
    
    # Compute confusion matrix and F1 score
    cm <- confusionMatrix(predicted_class, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    
    return(f1)
  })
  
  return(mean(f1_scores))
})

# Identify the best parameters
best_params <- params[which.max(params$f1), ]
print(best_params)

# Charger les bibliothèques nécessaires
library(xgboost)
library(caret)
library(dplyr)

# Préparation des données
# Assurez-vous que train2 et test2 sont bien nettoyés et préprocessés selon vos étapes précédentes.

# Transformation des variables catégoriques en indicatrices (dummy variables)
train_data <- dummy_cols(train2, select_columns = c('Gender', 'Driving_License', 'Region_Code', 'Previously_Insured', 'Vehicle_Age', 'Vehicle_Damage', 'Policy_Sales_Channel', 'agegroup', 'Vintagegroup',  'Premiumgroup'), remove_selected_columns = TRUE)

test_data <- dummy_cols(test2, select_columns = c('Gender', 'Driving_License', 'Region_Code', 'Previously_Insured', 'Vehicle_Age', 'Vehicle_Damage', 'Policy_Sales_Channel', 'agegroup', 'Vintagegroup',  'Premiumgroup'),  remove_selected_columns = TRUE)

# Créer des matrices pour xgboost
dtrain <- xgb.DMatrix(data = as.matrix(train_data %>% select(-Response)), 
                      label = as.numeric(as.character(train_data$Response)))

dtest <- xgb.DMatrix(data = as.matrix(test_data %>% select(-Response)), 
                     label = as.numeric(as.character(test_data$Response)))

# Définir les hyperparamètres du modèle
params <- list(
  booster = "gbtree",
  objective = "binary:logistic",   # Pour un problème de classification binaire
  eta = 0.1,                      # Taux d'apprentissage
  max_depth = 6,                  # Profondeur maximale des arbres
  eval_metric = "auc"             # Métrique d'évaluation
)

# Entraînement du modèle avec validation croisée
set.seed(123)
xgb_model <- xgb.train(
  params = params,
  data = dtrain,
  nrounds = 100,                  # Nombre d'itérations
  watchlist = list(train = dtrain, test = dtest),
  verbose = 1
)

# Prédictions sur le jeu de test
predictions <- predict(xgb_model, newdata = dtest)

# Calculer le seuil optimal basé sur le F1-score
thresholds <- seq(0.01, 1, by = 0.01)
f1_scores <- sapply(thresholds, function(thresh) {
  preds_binary <- as.numeric(predictions > thresh)
  confusion <- confusionMatrix(as.factor(preds_binary), as.factor(test_data$Response), positive = "1")
  confusion$byClass['F1']
})

optimal_threshold <- thresholds[which.max(f1_scores)]
cat("Seuil optimal:", optimal_threshold, "\n")

# Utiliser le seuil optimal pour les prédictions finales
final_predictions <- as.numeric(predictions > optimal_threshold)

# Évaluation finale
conf_matrix <- confusionMatrix(as.factor(final_predictions), as.factor(test_data$Response), positive = "1")
print(conf_matrix)
Saphir
Saphir Da Costa
# Installer et charger le package xgboost si nécessaire
if (!require(xgboost)) install.packages("xgboost")
library(xgboost)

# Préparer les données
# Transformer les jeux de données en matrices (requis par xgboost)
train_matrix <- xgb.DMatrix(
  data = as.matrix(train %>% select(-Response)),  # Toutes les colonnes sauf la cible
  label = as.numeric(as.character(train$Response))  # La variable cible convertie en numérique (0/1)
)

test_matrix <- xgb.DMatrix(
  data = as.matrix(test %>% select(-Response)),  # Toutes les colonnes sauf la cible
  label = as.numeric(as.character(test$Response))  # La variable cible convertie en numérique (0/1)
)

# Spécifier les paramètres du modèle
params <- list(
  objective = "binary:logistic",  # Classification binaire avec une sortie probabiliste
  eval_metric = "logloss",       # Utiliser log-loss comme métrique d'évaluation
  max_depth = 6,                 # Profondeur maximale des arbres
  eta = 0.1,                     # Taux d'apprentissage (valeurs faibles favorisent des modèles robustes)
  gamma = 0,                     # Paramètre de régularisation L1
  colsample_bytree = 0.8,        # Fraction des colonnes utilisées par arbre
  subsample = 0.8                # Fraction des lignes utilisées par arbre
)

# Entraîner le modèle
set.seed(123)  # Fixer une graine pour garantir la reproductibilité
xgb_model <- xgb.train(
  params = params,               # Paramètres définis ci-dessus
  data = train_matrix,           # Jeu de données d'entraînement
  nrounds = 100,                 # Nombre total d'itérations (arbres)
  watchlist = list(train = train_matrix),  # Suivre la performance sur le train
  verbose = 1                    # Afficher les progrès pendant l'entraînement
)

# Faire des prédictions sur le jeu de test
# Les prédictions sont des probabilités (entre 0 et 1)
pred_test <- predict(xgb_model, test_matrix)

# Convertir les probabilités en classes avec un seuil de 0.5
pred_class <- ifelse(pred_test > 0.5, 1, 0)

# Calculer les métriques de performance
library(caret)  # Pour la matrice de confusion et le F1-Score
confusion <- confusionMatrix(as.factor(pred_class), as.factor(test$Response), positive = "1")

# Récupérer le F1-Score
F1_score <- confusion$byClass['F1']
print(F1_score)  # Afficher le F1-Score
Saphir
Saphir Da Costa
Explications des paramètres importants
n.trees ou nrounds : Le nombre total d'arbres construits par le modèle. Plus d'arbres peuvent améliorer les performances, mais risquent de sur-apprendre si mal réglés.
interaction.depth ou max_depth : La profondeur maximale des arbres. Les arbres plus profonds capturent des relations complexes, mais peuvent aussi sur-apprendre.
shrinkage ou eta : Le taux d'apprentissage, qui détermine l'importance de chaque arbre ajouté. Une valeur faible favorise une convergence lente mais robuste.
cv.folds ou validation croisée : Utilisé pour trouver le nombre optimal d'arbres en évaluant la performance sur des plis de validation.
objective : Spécifie le type de tâche. Ici, binary:logistic pour une classification binaire.
Que choisir entre gbm et xgboost ?
gbm : Plus simple à configurer et utile pour les analyses exploratoires.
xgboost : Plus rapide, efficace sur de grandes bases, et permet un contrôle plus fin des hyperparamètres.

3.6 ligthGBM

library(lightgbm)
library(caret)
library(data.table) # For data manipulation if needed

# Define the parameter grid
params <- expand.grid(
  nrounds = c(1000, 1500, 2000),
  max_depth = seq(3, 6, 1),
  learning_rate = seq(0.001, 0.3, 0.01),
  min_data_in_leaf = seq(5, 30, 7),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

k <- 3  # Number of folds
set.seed(123)
folds <- createFolds(train$Response, k = k, list = TRUE)

params$f1 <- sapply(1:nrow(params), function(i) {
  
  # Retrieve hyperparameter values
  nrounds_value <- params$nrounds[i]
  max_depth_value <- params$max_depth[i]
  learning_rate_value <- params$learning_rate[i]
  min_data_in_leaf_value <- params$min_data_in_leaf[i]
  
  # Compute F1 scores for each fold
  f1_scores <- sapply(1:k, function(j) {
    
    # Split data into training and validation
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    
    # Prepare data for LightGBM
    dtrain <- lgb.Dataset(data = as.matrix(train_fold[, -which(names(train_fold) == "Response")]),
                          label = train_fold$Response)
    dvalid <- lgb.Dataset(data = as.matrix(valid_fold[, -which(names(valid_fold) == "Response")]),
                          label = valid_fold$Response)
    
    # Train the LightGBM model
    lgb_model <- lgb.train(
      params = list(
        max_depth = max_depth_value,
        learning_rate = learning_rate_value,
        min_data_in_leaf = min_data_in_leaf_value,
        objective = "binary"
      ),
      data = dtrain,
      nrounds = nrounds_value,
      valids = list(validation = dvalid),
      verbose = -1
    )
    
    # Make predictions
    predictions <- predict(lgb_model, as.matrix(valid_fold[, -which(names(valid_fold) == "Response")]))
    predicted_class <- ifelse(predictions > 0.5, 1, 0)
    
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predicted_class <- factor(predicted_class, levels = c(0, 1))
    
    # Compute confusion matrix and F1 score
    cm <- confusionMatrix(predicted_class, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    
    return(f1)
  })
  
  # Return the average F1 score across folds
  return(mean(f1_scores))
})

# Identify the best parameters
best_params <- params[which.max(params$f1), ]
print(best_params)

3.7 SVM linéaire

library(e1071)
library(caret)
library(data.table) # For data manipulation if needed

# Define the parameter grid
params <- expand.grid(
  cost = seq(0.1, 2, 0.1),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

k <- 3  # Number of folds
set.seed(123)
folds <- createFolds(train$Response, k = k, list = TRUE)

params$f1 <- sapply(1:nrow(params), function(i) {
  
  # Retrieve hyperparameter values
  cost_value <- params$cost[i]
  
  # Compute F1 scores for each fold
  f1_scores <- sapply(1:k, function(j) {
    
    # Split data into training and validation
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    
    # Train the SVM model with a linear kernel
    svm_model <- svm(
      Response ~ ., data = train_fold,
      type = "C-classification",
      kernel = "linear",
      cost = cost_value
    )
    
    # Make predictions
    predictions <- predict(svm_model, newdata = valid_fold)
    
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predictions <- factor(predictions, levels = c(0, 1))
    
    # Compute confusion matrix and F1 score
    cm <- confusionMatrix(predictions, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    
    return(f1)
  })
  
  # Return the average F1 score across folds
  return(mean(f1_scores))
})

# Identify the best parameters
best_params <- params[which.max(params$f1), ]
print(best_params)

3.8 SVM à Noyau

library(e1071)
library(caret)
library(data.table) # For data manipulation if needed

k <- 3  # Number of folds
set.seed(123)
folds <- createFolds(train$Response, k = k, list = TRUE)

# Radial Kernel
params_radial <- expand.grid(
  cost = seq(0.1, 2, 0.1),
  gamma = seq(0.01, 1, 0.05),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

params_radial$f1 <- sapply(1:nrow(params_radial), function(i) {
  cost_value <- params_radial$cost[i]
  gamma_value <- params_radial$gamma[i]
  f1_scores <- sapply(1:k, function(j) {
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    svm_model <- svm(
      Response ~ ., data = train_fold,
      type = "C-classification",
      kernel = "radial",
      cost = cost_value,
      gamma = gamma_value
    )
    predictions <- predict(svm_model, newdata = valid_fold)
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predictions <- factor(predictions, levels = c(0, 1))
    cm <- confusionMatrix(predictions, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    return(f1)
  })
  return(mean(f1_scores))
})

best_params_radial <- params_radial[which.max(params_radial$f1), ]
print(best_params_radial)

# Polynomial Kernel
params_poly <- expand.grid(
  cost = seq(0.1, 2, 0.1),
  gamma = seq(0.01, 1, 0.05),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

params_poly$f1 <- sapply(1:nrow(params_poly), function(i) {
  cost_value <- params_poly$cost[i]
  gamma_value <- params_poly$gamma[i]
  f1_scores <- sapply(1:k, function(j) {
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    svm_model <- svm(
      Response ~ ., data = train_fold,
      type = "C-classification",
      kernel = "polynomial",
      cost = cost_value,
      gamma = gamma_value
    )
    predictions <- predict(svm_model, newdata = valid_fold)
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predictions <- factor(predictions, levels = c(0, 1))
    cm <- confusionMatrix(predictions, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    return(f1)
  })
  return(mean(f1_scores))
})

best_params_poly <- params_poly[which.max(params_poly$f1), ]
print(best_params_poly)

# Sigmoid Kernel
params_sigmoid <- expand.grid(
  cost = seq(0.1, 2, 0.1),
  gamma = seq(0.01, 1, 0.05),
  f1 = 0,
  KEEP.OUT.ATTRS = FALSE
)

params_sigmoid$f1 <- sapply(1:nrow(params_sigmoid), function(i) {
  cost_value <- params_sigmoid$cost[i]
  gamma_value <- params_sigmoid$gamma[i]
  f1_scores <- sapply(1:k, function(j) {
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    svm_model <- svm(
      Response ~ ., data = train_fold,
      type = "C-classification",
      kernel = "sigmoid",
      cost = cost_value,
      gamma = gamma_value
    )
    predictions <- predict(svm_model, newdata = valid_fold)
    valid_fold$Response <- factor(valid_fold$Response, levels = c(0, 1))
    predictions <- factor(predictions, levels = c(0, 1))
    cm <- confusionMatrix(predictions, valid_fold$Response, positive = "1")
    sensitivity <- cm$byClass['Sensitivity']
    precision <- cm$byClass['Precision']
    f1 <- (2 * precision * sensitivity) / (precision + sensitivity)
    return(f1)
  })
  return(mean(f1_scores))
})

best_params_sigmoid <- params_sigmoid[which.max(params_sigmoid$f1), ]
print(best_params_sigmoid)

3.9 KNN

# hyperparamètres à tuner
params <- expand.grid(k = c(3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25),  
                      seuil = seq(0.1, 0.9, 0.1),
                      f1 = 0, 
                      KEEP.OUT.ATTRS = FALSE)

k_folds <- 4 
set.seed(123)  
folds <- createFolds(train$Response, k = k_folds, list = TRUE)

#  F1-score
params$f1 <- sapply(1:nrow(params), function(i) {
  
  f1_scores <- sapply(1:k_folds, function(j) {
    
    train_fold <- train[-folds[[j]], ]
    valid_fold <- train[folds[[j]], ]
    
    # Entraîner le modèle KNN
    knn_model <- knn3(Response ~ ., 
                      data = train_fold,
                      k = params[i, "k"],
                      prob = TRUE,
                      use.all = TRUE, 
                      l = 0)
    
    prob <- predict(knn_model, newdata = valid_fold)
    seuil <- params[i, "seuil"]
    predictions <- ifelse(prob[, 2] >= seuil, "Positif", "Négatif")
    predictions <- factor(predictions, levels = c("Négatif", "Positif"))
    cm <- confusionMatrix(predictions , valid_fold$Response, positive = "Positif")
    f1 <- cm$byClass['F1']
    
    return(f1)
  })
  
  # Retourner le F1-score moyen pour les k plis
  return(mean(f1_scores))
})

# meilleure combinaison
best_params <- params[which.max(params$f1), ]
print(best_params)

3.10 Réseau de neurones

install.packages("keras")
install_keras() 
library(keras)
library(caret)
library(tensorflow)
library(parallel)

# Normalisation des variables numériques
num_vars <- c("Age", "Driving License", "Region Code", "Annual Premium", "Policy Sales Channel", "Vintage")
train[num_vars] <- scale(train[num_vars])
X <- train[, c("Gender", "Age", "Driving License", "Region Code", "Previously Insured", "Vehicle Age", "Vehicle Damage", "Annual Premium", "Policy Sales Channel", "Vintage")]
y <- train$Response

3.10.1 Création d’une fonction pour le modèle de réseau de neurones

# Fonction pour construire le modèle de réseau de neurones
build_model <- function(num_layers, units, activation, regularizer) {
  model <- keras_model_sequential()
  
  # Ajouter les couches cachées
  for (i in 1:num_layers) {
    model %>% layer_dense(units = units, activation = activation,
                          kernel_regularizer = regularizer_l2(regularizer),
                          input_shape = ncol(X))
  }
  
  # Ajouter une couche de sortie pour la classification binaire
  model %>% layer_dense(units = 1, activation = "sigmoid")
  
  # Compiler le modèle
  model %>% compile(optimizer = "adam", loss = "binary_crossentropy", metrics = c("accuracy"))
  
  return(model)
}

3.10.2 Mise en place de la grille des hyperparamètres à tuner dans le modèle de réseau de neurones et validation croisée

Pour optimiser la performance de notre modèle de réseau de neurones pour cette tâche de classification binaire, plusieurs hyperparamètres peuvent être ajustés. Ces paramètres influencent directement la capacité du modèle à s’ajuster aux données tout en évitant le sur-apprentissage (overfitting). Voici les principaux paramètres que nous avons choisis de tuner :

Nombre de couches (num_layers) :
- Ce paramètre détermine le nombre de couches cachées dans le réseau de neurones. Un nombre plus élevé de couches permet au modèle de capturer des relations plus complexes dans les données, mais cela peut également augmenter le risque de sur-apprentissage. Un nombre trop faible de couches pourrait entraîner une sous-performance du modèle, car il pourrait ne pas être capable d’extraire suffisamment de caractéristiques complexes.
- Dans notre grille de recherche, nous avons testé différentes valeurs, allant de 1 à 3 couches.
Nombre de neurones par couche (units) :
- Ce paramètre détermine combien de neurones chaque couche cachée contient. Un nombre plus élevé de neurones permet au modèle de capturer des informations plus fines et de mieux modéliser les relations complexes dans les données. Cependant, plus de neurones signifient également plus de paramètres à ajuster, ce qui peut entraîner une augmentation du temps d’entraînement et un risque accru de sur-apprentissage.
- Nous avons exploré trois valeurs pour ce paramètre : 16, 32 et 64 neurones par couche.
Fonction d’activation (activation) :
- La fonction d’activation décide comment les informations circulent d’une couche à l’autre dans le réseau. Les fonctions d’activation courantes comprennent ReLU (Rectified Linear Unit), qui est largement utilisée dans les réseaux de neurones en raison de son efficacité à prévenir le problème du gradient qui disparaît, et sigmoid, qui est utilisée dans les problèmes de classification binaire. Le choix de la fonction d’activation influence la capacité d’apprentissage du modèle et sa convergence pendant l’entraînement.
- Dans notre grille de recherche, nous avons exploré deux options : ReLU et sigmoid.
Régularisation (regularizer) :
- La régularisation est une technique utilisée pour éviter le sur-apprentissage en pénalisant les poids trop grands dans le modèle. Nous avons utilisé la régularisation L2 (aussi appelée ridge regression), qui ajoute une pénalité au terme de perte proportionnelle au carré des poids du modèle. Cela incite le modèle à apprendre des poids plus petits et plus simples, améliorant ainsi sa capacité à généraliser.
- Le paramètre de régularisation est contrôlé par la valeur de lambda (régularisation L2), qui détermine l’importance de cette pénalité. Nous avons testé différentes valeurs : 0, 0.001 et 0.01.

# Définir la grille des hyperparamètres
hyper_grid <- expand.grid(
  num_layers = c(1, 2, 3),                      # Nombre de couches
  units = c(16, 32, 64),                        # Nombre de neurones par couche
  activation = c("relu", "sigmoid"),            # Fonction d'activation
  regularizer = c(0, 0.001, 0.01)               # Paramètre de régularisation (L2)
)

# Fonction pour calculer le F1-score via une validation croisée
folds <- createFolds(y, k = 5, list = TRUE, returnTrain = TRUE)

# Initialiser les variables pour stocker les résultats
results <- data.frame()

# Initialiser le nombre de cœurs à utiliser pour la parallélisation
num_cores <- detectCores() - 1  # Utiliser un cœur de moins pour ne pas saturer le système
cl <- makeCluster(num_cores)

# Exporter les objets nécessaires dans le cluster parallèle
clusterExport(cl, list("X", "y", "build_model", "folds", "keras", "confusionMatrix"))

# Grid search avec validation croisée et optimisation du F1
grid_search <- parLapply(cl, 1:nrow(hyper_grid), function(i) {
  params <- hyper_grid[i, ]
  
  # Initialiser le score F1 pour cette configuration
  f1_scores <- c()
  
  # Validation croisée
  for (j in 1:length(folds)) {
    train_fold <- X[folds[[j]], ]
    valid_fold <- X[-folds[[j]], ]
    train_labels <- y[folds[[j]]]
    valid_labels <- y[-folds[[j]]]
    
    # Construire et entraîner le modèle
    model <- build_model(
      num_layers = params$num_layers,
      units = params$units,
      activation = as.character(params$activation),
      regularizer = params$regularizer
    )
    
    # Entraîner le modèle
    history <- model %>% fit(
      train_fold, train_labels,
      epochs = 10,
      batch_size = 32,
      validation_data = list(valid_fold, valid_labels),
      verbose = 0
    )
    
    # Prédictions sur l'ensemble de validation
    predictions <- model %>% predict(valid_fold)
    predictions <- ifelse(predictions > 0.5, 1, 0)  # Seuil de 0.5 pour la classification
    
    # Calculer le score F1 pour ce pli
    cm <- confusionMatrix(factor(predictions), factor(valid_labels), positive = "1")
    f1 <- cm$byClass["F1"]
    
    # Ajouter le F1-score pour ce pli
    f1_scores <- c(f1_scores, f1)
  }
  
  # Calculer la moyenne des F1-scores pour tous les plis
  mean_f1 <- mean(f1_scores)
  
  # Retourner les paramètres et le score F1 moyen
  return(cbind(params, mean_f1))
})

# Arrêter le cluster après le calcul
stopCluster(cl)

# Combiner les résultats
results <- do.call(rbind, grid_search)

# Trouver la meilleure combinaison d'hyperparamètres
best_params <- results[which.max(results$mean_f1), ]
print(best_params)

1 📚 Introduction

1.1 🌱 Contexte

1.2 📑 définition du problème

1.2.1 Dictionnaire de données

1.2.2 importation de la base de donnée

2 🔍 Analyse exploratoire des données

2.1 📝 Résumé des variables catégorielles

2.2 📊 analyses visuelles des variables catégorielles

2.2.1 Region_Code

2.2.1.1 choix du seuil optimal de regroupement

2.2.2 Policy_Sales_Channel

2.2.2.1 choix du seuil optimal de regroupement

2.3 📝 Résumé des variables numériques

2.4 📊 analyses visuelles des variables numériques

2.4.1 Vintage

2.4.1.1 Age

2.4.2 Annual_Premium

2.5 ⚖️ Ensemble de données déséquilibré

2.5.1 analyses de la déformation des données par oversampling

3 Modèles

3.1 CART

3.2 Régression logistique

3.3 Random Forest

3.4 Gradient Boosting

3.5 XGBoost

3.6 ligthGBM

3.7 SVM linéaire

3.8 SVM à Noyau

3.9 KNN

3.10 Réseau de neurones

3.10.1 Création d’une fonction pour le modèle de réseau de neurones

3.10.2 Mise en place de la grille des hyperparamètres à tuner dans le modèle de réseau de neurones et validation croisée

2.2.1 `Region_Code`

2.2.2 `Policy_Sales_Channel`

2.4.1 `Vintage`

2.4.1.1 `Age`

2.4.2 `Annual_Premium`