library(ggplot2)
library(dplyr)
library(ChainLadder)
library(MASS)
library(readr)
source("ChainLondon.R")
source("Taylor.R")

Théorie

Data <- read_csv("Downloads/data.csv")

Les densités de paiement montrent que, d’année en année, les paiements avec des délais plus courts deviennent de plus en plus nombreux.

Data_filtered <- Data %>%
  filter(DelaiPaiement >= 1 & DelaiPaiement <= 100, !is.na(Année))

# Tracer les densités par année
ggplot(Data_filtered, aes(x = DelaiPaiement, color = as.factor(Année))) +
  geom_density(size = 1.2) +
  labs(title = "Densité des délais de paiement par année",
       x = "Délais de Paiement",
       y = "Densité",
       color = "Année") +
  theme_minimal()

Les cadences de paiement ne sont pas constantes d’une année à l’autre, ce qui rend difficile l’adaptation des méthodes déterministes. Ces dernières peuvent alors produire des provisions biaisées. Pour corriger ces biais, une approche consiste à se placer dans un scénario fictif où les délais de paiement sont supposés normaux, c’est-à-dire sans accélération ni ralentissement.

En supposant que les années 2021 et 2022 avaient des délais de paiement stables (sans modification), l’objectif est maintenant d’estimer de nouveaux délais de paiement pour l’année 2023. Cette estimation permettra de corriger l’effet de la baisse des délais observée et d’obtenir des provisions plus précises.

Algorithme : Méthode de calcul des provisions

  1. Entrée : B2021-2022 et B2023.
  2. Séparer la base B2021-2022 en deux sous-bases :
    • Une pour l’apprentissage (Bapp_2021-2022).
    • Une pour les tests et validations (Bval_2021-2022).
  3. Appliquer un modèle d’apprentissage (GLM, CART, réseaux de neurones, etc.) sur la base Bapp_2021-2022 pour modéliser les délais de paiement.
  4. Valider la modélisation à l’aide de la base Bval_2021-2022.
  5. Faire des prédictions des nouveaux délais de paiement sur la base B2023.
  6. Recalculer les dates de paiement pour 2023 en utilisant la formule : \[ \text{DatePaiement} = \text{DateSurvenance} + \text{NouveauDelais} \]
  7. Valider les nouvelles cadences de règlement en fonction des hypothèses des méthodes déterministes.
  8. Utiliser les données des paiements de 2021, 2022 et 2023 avec les nouvelles valeurs pour 2023 pour agréger les paiements dans le triangle de paiement.
  9. Calculer les provisions avec la méthode de Taylor arithmétique.
  10. Sortie : Provision calculée.

Calcul des nouveaux delais

Cette section vise à illustrer les principales caractéristiques de notre base de données. Les résultats présentés ici ne feront pas l’objet d’une analyse détaillée et seront interprétés avec une certaine souplesse. Nous disposons d’un jeu de données contenant les variables suivantes :

names(Data)
##  [1] "CodeGe"            "Age"               "SexeBen"          
##  [4] "DeptBen"           "CategorieBen"      "TypeContrat"      
##  [7] "TypePaiement"      "PeriodeSurvenance" "PeriodePaiement"  
## [10] "DelaiPaiement"     "RembOam"           "Année"

Les données de l’année 2023 seront utilisées comme données de prédiction, tandis que celles des années 2021 et 2022 serviront à entraîner nos modèles.

Data_2023 <- subset(Data, Année == 2023)
Data_2021_2022 <- subset(Data, Année != 2023)

Afin de construire et d’évaluer notre modèle, nous divisons les données 2021-2022 en deux ensembles :

  • Ensemble d’entraînement (train) : utilisé pour ajuster le modèle.
  • Ensemble de test (test) : utilisé pour évaluer la performance du modèle.

Nous effectuons cette répartition en prenant 80% des données pour l’entraînement et 20% pour le test de manière aléatoire.

set.seed(123)
train_index <- sample(1:nrow(Data_2021_2022), 0.8 * nrow(Data_2021_2022))
train <- Data_2021_2022[train_index, ]
test <- Data_2021_2022[-train_index, ]

Cette répartition nous permettra d’évaluer la capacité de généralisation de notre modèle avant son application aux données de 2023.

# Ajustement du modèle GLM
glm_model <- glm(DelaiPaiement ~ CodeGe+Age+SexeBen+DeptBen+CategorieBen+TypeContrat+TypePaiement, 
                 data = train, 
                 family = Gamma(link = "log"))

summary(glm_model)
## 
## Call:
## glm(formula = DelaiPaiement ~ CodeGe + Age + SexeBen + DeptBen + 
##     CategorieBen + TypeContrat + TypePaiement, family = Gamma(link = "log"), 
##     data = train)
## 
## Coefficients:
##                Estimate Std. Error  t value Pr(>|t|)    
## (Intercept)    2.040180   0.352054    5.795 6.83e-09 ***
## CodeGeAPP     -0.534913   0.011061  -48.361  < 2e-16 ***
## CodeGeDENT    -0.516578   0.015810  -32.674  < 2e-16 ***
## CodeGeHOSP     0.839601   0.018783   44.700  < 2e-16 ***
## CodeGeOPT      0.150370   0.019741    7.617 2.59e-14 ***
## CodeGeORT      0.802811   0.052864   15.186  < 2e-16 ***
## CodeGePHA     -0.837551   0.008279 -101.167  < 2e-16 ***
## CodeGePRO      0.400254   0.022071   18.135  < 2e-16 ***
## CodeGeSME     -0.107211   0.007141  -15.013  < 2e-16 ***
## Age            0.002861   0.000167   17.134  < 2e-16 ***
## SexeBenF       0.656887   0.351679    1.868 0.061782 .  
## SexeBenM       0.580069   0.351684    1.649 0.099066 .  
## DeptBenBFC    -0.026488   0.023787   -1.114 0.265469    
## DeptBenBRE    -0.021713   0.019994   -1.086 0.277488    
## DeptBenC20R    0.128951   0.068830    1.873 0.061004 .  
## DeptBenCVL     0.032248   0.020420    1.579 0.114280    
## DeptBenGES     0.045510   0.021819    2.086 0.036998 *  
## DeptBenHDF     0.116079   0.017127    6.778 1.22e-11 ***
## DeptBenIDF     0.423545   0.014139   29.957  < 2e-16 ***
## DeptBenNAQ     0.014946   0.017942    0.833 0.404825    
## DeptBenNOR     0.012859   0.020080    0.640 0.521918    
## DeptBenOCC     0.059757   0.017722    3.372 0.000747 ***
## DeptBenOME     0.041305   0.019370    2.132 0.032972 *  
## DeptBenPAC     0.038668   0.019568    1.976 0.048141 *  
## DeptBenPDL    -0.073878   0.020647   -3.578 0.000346 ***
## CategorieBenC -0.127434   0.006849  -18.605  < 2e-16 ***
## CategorieBenE  0.199269   0.012885   15.465  < 2e-16 ***
## TypeContratIN -0.077449   0.006027  -12.851  < 2e-16 ***
## TypePaiementN  1.886753   0.061971   30.446  < 2e-16 ***
## TypePaiementV  0.590117   0.006554   90.041  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Gamma family taken to be 4.819288)
## 
##     Null deviance: 1082213  on 660078  degrees of freedom
## Residual deviance:  825890  on 660049  degrees of freedom
## AIC: 5373952
## 
## Number of Fisher Scoring iterations: 8

Le \(R^2\) de de McFadden est donnée par :

(r2_mcfadden <- 1 - (glm_model$deviance / glm_model$null.deviance))
## [1] 0.2368506

Ce modèle permet d’expliquer à peine 23,% des délais de paiement. Cependant, comme mentionné précédemment, l’accent ne sera pas mis sur les résultats, mais uniquement sur la méthode. La prochaine étape consiste à passer à la prédiction des nouveaux délais de paiement.

test$Predictions <- predict(glm_model, newdata = test, type = "response")
Data_2023$Nouveau_DelaiPaiement <- predict(glm_model, newdata = Data_2023, type = "response")
head(Data_2023[, c("DelaiPaiement", "Nouveau_DelaiPaiement")])
## # A tibble: 6 × 2
##   DelaiPaiement Nouveau_DelaiPaiement
##           <dbl>                 <dbl>
## 1             9                 38.6 
## 2            14                 27.4 
## 3             2                  7.12
## 4             2                 18.2 
## 5            11                  9.68
## 6             9                 17.1
Data_2023$Nouveau_PeriodePaiement = round(Data_2023$PeriodeSurvenance+Data_2023$Nouveau_DelaiPaiement/30+1, 0)

Data2023_Final <- Data_2023 %>% 
  dplyr::select(RembOam, Nouveau_PeriodePaiement, PeriodeSurvenance) %>% 
  rename(PeriodePaiement = Nouveau_PeriodePaiement)

Data_2021_2022_Final <- Data_2021_2022 %>% 
  dplyr::select(RembOam, PeriodePaiement, PeriodeSurvenance)

Data_final = rbind(Data_2021_2022_Final, Data2023_Final)

Calcul des IBNR

Application des méthodes de Chain Ladder, London Chain et Taylor pour les prévisions.

names(Data_final) = c('Mois_Declaration', "Mois_Survenance", "Montant")
Data_final$Mois_Declaration_ladder = Data_final$Mois_Declaration -Data_final$Mois_Survenance + 1
ibnr <- function(data_paiement){
  return(sum(data_paiement[, ncol(data_paiement)] - 
        data_paiement[row(data_paiement) + 
                        col(data_paiement) == ncol(data_paiement) + 1]))}
  

triangle_paiement_cumule <- function(data_paiement, Row, Col){
  
  Triangle_paiement_cumules <- matrix(NA, ncol = Col, nrow = Row)
  
  data_paiement <- data_paiement %>%
    group_by(Mois_Survenance, Mois_Declaration_ladder) %>%
    summarise(Montant = sum(Montant), .groups = "drop")

  for(i in 1:Row) {
    cum_sum <- 0
    for(j in 1:Col) {
      if(i + j <= Row + 1) {
        subdata <- subset(data_paiement, Mois_Survenance == i & Mois_Declaration_ladder == j)
        if(nrow(subdata) > 0) {
          cum_sum <- cum_sum + sum(subdata$Montant)
          Triangle_paiement_cumules[i, j] <- cum_sum  # Remplissage de la matrice avec la somme cumulative
        } else {
          Triangle_paiement_cumules[i, j] <- cum_sum  # Ajoute 0 à la somme si aucune donnée
        }
      }
    }
  }
  return(Triangle_paiement_cumules)
  }


Triangle_paiement_cumules = triangle_paiement_cumule(Data_final, 36, 36)


(chainladder_ppap = ibnr(MackChainLadder(Triangle_paiement_cumules, est.sigma="Mack")$FullTriangle))
## [1] 4728573
(Londonchain_ppap = Londonchain(Triangle_paiement_cumules, TRUE)$IBNR)

## [1] 4415165

Pour la methode de Taylor Arithmetique.

triangle_paiement_taylor <- function(data_paiement, Row, Col) {
  Triangle <- matrix(0, ncol = Col, nrow = Row)
  
  data_paiement <- data_paiement %>%
    group_by(Mois_Survenance, Mois_Declaration) %>%
    summarise(Montant = sum(Montant), .groups = "drop")
  
  for (i in 1:Row) {
    for (j in 1:Col) {
      Triangle[i, j] <- sum(data_paiement$Montant[data_paiement$Mois_Survenance == i & 
                                                   data_paiement$Mois_Declaration == j], na.rm = TRUE)
    }
  }
  return(Triangle)
}

Triangle__taylor <- triangle_paiement_taylor(Data_final, 36, 36)
(Taylor_ppap = Taylor(Triangle__taylor, Min = 1, Max = 36, decoupe = 36))
##   Periode Provision
## 1       1   4891590

Les provisions obtenues sont assez proches de celles estimées dans le mémoire d’actuariat. Cette méthode fournit de bonnes estimations, mais manque de clarté et d’approfondissement, ce qui explique pourquoi elle n’a pas été retenue.