Risque de concentration en assurance — Solution au défi Actulab Cooperators

Comment modéliser le risque de concentration en assurance ?

Ce projet propose une solution au défi Actulab Cooperators : une simulation Monte Carlo du risque de concentration en Alberta utilisant R. Les orages de grêle sont modélisés par des ellipses concentriques et le vol par une approche fréquence-sévérité. Le code complet inclut des fonctions de détection d’appartenance à une ellipse, du calcul parallélisé et une analyse comparative de la concentration du risque.

Tu trouveras les fichiers sources complets dans le dossier d’images de cet article, notamment cooperators.Rnw (document Sweave original), ellipse.R, mcsapply.R, ainsi que les données agents.csv et assures.csv.

🌘 Contexte : le défi Actulab Cooperators

Le défi Actulab proposé par Cooperators portait sur la modélisation du risque de concentration en assurance. En assurance, la concentration du risque est un enjeu majeur : si tous tes assurés sont exposés aux mêmes événements (une tempête de grêle, une inondation), tes pertes peuvent être catastrophiques.

La solution présentée ici simule des orages de grêle sous forme d’ellipses concentriques, calcule les dommages pour chaque orage, et compare les résultats avec un échantillon moins concentré d’assurés. Une section modélise aussi le vol par une approche fréquence-sévérité classique.

🌘 Initialisation et librairies

On commence par fixer la graine aléatoire, charger les librairies et définir le taux d’échantillonnage pour la comparaison avec moins de concentration.

set.seed(908144032)
library("actuar")
library("parallel")
source("mcsapply.R")
nb.conc <- 50

🌘 Risque associé aux tempêtes de grêle

Une tempête de grêle peut créer beaucoup de dommages dans une zone concentrée en peu de temps. Plusieurs facteurs influencent la sévérité des dommages : le diamètre des grêlons (sévérité) et la taille de l’orage (nombre d’assurés touchés).

J’ai choisi de modéliser les orages selon une force de 1 à 4, qui influence à la fois la taille et la sévérité. Pour déterminer facilement si un assuré est touché, j’ai donné aux orages une forme elliptique. Un orage de force 4 est composé de 4 ellipses concentriques, chacune avec un niveau de dommage distinct.

Les coordonnées (longitude, latitude) des assurés sont les seules données utilisées. Les montants et paramètres statistiques ont été fixés arbitrairement pour donner des résultats raisonnables.

🌘 Définition des ellipses

L’ellipse est représentée sous forme paramétrique et canonique. La fonction dans_ellipse_param détermine si un point appartient à l’ellipse.

ellipse_param <- function(t, X, Y, a, b, phi)
{
  cbind(X + a * cos(t) * cos(phi) - b * sin(t) * sin(phi),
        Y + a * cos(t) * sin(phi) + b * sin(t) * cos(phi))
}

dans_ellipse_param <- function(coord, param)
{
  x <- coord[,1]
  y <- coord[,2]
  xc <- param[1]
  yc <- param[2]
  a <- param[3]
  b <- param[4]
  phi <- param[5]
  (((x - xc) * cos(phi) - (y - yc) * sin(phi))^2 / a^2 +
    ((x - xc) * sin(phi) + (y - yc) * cos(phi))^2 / b^2) <= 1
}

🌘 Importation des données

Les agents et assurés sont stockés dans des fichiers CSV séparés par des deux-points.

agents <- read.csv("agents.csv", sep = ":")
assures <- read.csv("assures.csv", sep = ":")
n.assures <- nrow(assures)

Carte des assurés (croix noires) et des agents (triangles rouges) en Alberta

On définit la zone rectangulaire couvrant les assurés, et on prépare un sous-groupe moins concentré (un assuré sur nb.conc).

coord_assures <- cbind(assures$Longitude_Assure,
                       assures$Latitude_Assure)
range_longitude <- c(min(coord_assures[,1]),
                     max(coord_assures[,1]))
range_latitude <- c(min(coord_assures[,2]),
                    max(coord_assures[,2]))

coord_assures2 <- coord_assures[seq(1, 32669, by = nb.conc),]

🌘 Hypothèses de modélisation

Les paramètres suivants sont utilisés pour la simulation Monte Carlo :

franchise <- 500
n.annees <- 100
n.moyen.orages <- 10
longueur.orage <- 1
largeur.orage <- 0.2
angle.dominant <- 1/2
ecart.angle <- 1
prob_forces <- c(0.8, 0.15, 0.04, 0.01)
facteur_forces <- c(1, 1.5, 2, 2.5)
param_dommages <- c(50, 1000, 20000, 400000)
param_forme <- 2

La franchise est de 500 $.
Le nombre d’années simulées est de 100.
Le nombre d’orages par année suit une loi Poisson de moyenne 10.
La position du centre de l’orage est uniforme sur le rectangle des assurés.
La longueur et la largeur suivent des lois exponentielles.
Les vents dominants sont à 0,5 radian avec une variation selon une bêta(2,2).
La force (1 à 4) suit une distribution discrète.
Les dommages suivent une distribution Pareto (paramètre de forme 2) dont l’échelle dépend de la force.

🌘 Simulation des orages

On simule l’ensemble des orages sur 100 ans :

orages_annees <- rpois(n.annees, n.moyen.orages)
n.orages <- sum(orages_annees)

sim_xc <- runif(n.orages, range_longitude[1], range_longitude[2])
sim_yc <- runif(n.orages, range_latitude[1], range_latitude[2])
sim_a <- rexp(n.orages, 1 / longueur.orage)
sim_b <- rexp(n.orages, 1 / largeur.orage)
sim_angle <- angle.dominant - ecart.angle +
  2 * ecart.angle * rbeta(n.orages, 2, 2)
sim_force <- sample(x = 1:4, size = n.orages,
                    replace = TRUE, prob = prob_forces)

sim_param_orages_1 <- cbind(sim_xc, sim_yc,
                            facteur_forces[1] * sim_a,
                            facteur_forces[1] * sim_b, sim_angle)
sim_param_orages_2 <- cbind(sim_xc, sim_yc,
                            facteur_forces[2] * sim_a,
                            facteur_forces[2] * sim_b, sim_angle)
sim_param_orages_3 <- cbind(sim_xc, sim_yc,
                            facteur_forces[3] * sim_a,
                            facteur_forces[3] * sim_b, sim_angle)
sim_param_orages_4 <- cbind(sim_xc, sim_yc,
                            facteur_forces[4] * sim_a,
                            facteur_forces[4] * sim_b, sim_angle)

Pour chaque orage, on compte le nombre d’assurés touchés selon la force :

touches1 <- numeric(n.orages)
touches2 <- numeric(n.orages)
touches3 <- numeric(n.orages)
touches4 <- numeric(n.orages)

for (i in 1:n.orages)
{
  touches1[i] <- sum((sim_force[i] >= 1) *
    dans_ellipse_param(coord_assures, sim_param_orages_1[i,]))
  touches2[i] <- sum((sim_force[i] >= 2) *
    dans_ellipse_param(coord_assures, sim_param_orages_2[i,]))
  touches3[i] <- sum((sim_force[i] >= 3) *
    dans_ellipse_param(coord_assures, sim_param_orages_3[i,]))
  touches4[i] <- sum((sim_force[i] >= 4) *
    dans_ellipse_param(coord_assures, sim_param_orages_4[i,]))
}

rpareto_tronque <- function(n, shape, scale, deductible)
{
  pmax(rpareto(n, shape, scale) - deductible, 0)
}

On calcule les dommages avec une fonction parallélisée mcsapply :

dommages <- mcsapply(mcsapply(as.list(touches1),
                      rpareto_tronque, param_forme,
                      param_dommages[1], franchise), sum) +
  mcsapply(mcsapply(as.list(touches2),
                      rpareto_tronque, param_forme,
                      param_dommages[2], franchise), sum) +
  mcsapply(mcsapply(as.list(touches3),
                      rpareto_tronque, param_forme,
                      param_dommages[3], franchise), sum) +
  mcsapply(mcsapply(as.list(touches4),
                      rpareto_tronque, param_forme,
                      param_dommages[4], franchise), sum)

dommages_cum <- cumsum(dommages)
orages_annees_cum <- cumsum(orages_annees)
dommages_annuels <- diff(dommages_cum[orages_annees_cum])

Les quantiles des dommages annuels pour l’ensemble des assurés :

quantile(dommages_annuels, c(0.5, 0.75, 0.9, 0.95, 0.99))

🌘 Comparaison avec moins de concentration

Pour visualiser l’effet de la concentration, on sélectionne un assuré sur nb.conc (50) et on réutilise les mêmes orages :

touches21 <- numeric(n.orages)
touches22 <- numeric(n.orages)
touches23 <- numeric(n.orages)
touches24 <- numeric(n.orages)

for (i in 1:n.orages)
{
  touches21[i] <- sum((sim_force[i] >= 1) *
    dans_ellipse_param(coord_assures2, sim_param_orages_1[i,]))
  touches22[i] <- sum((sim_force[i] >= 2) *
    dans_ellipse_param(coord_assures2, sim_param_orages_2[i,]))
  touches23[i] <- sum((sim_force[i] >= 3) *
    dans_ellipse_param(coord_assures2, sim_param_orages_3[i,]))
  touches24[i] <- sum((sim_force[i] >= 4) *
    dans_ellipse_param(coord_assures2, sim_param_orages_4[i,]))
}

dommages2 <- mcsapply(mcsapply(as.list(touches21),
                      rpareto_tronque, param_forme,
                      param_dommages[1], franchise), sum) +
  mcsapply(mcsapply(as.list(touches22),
                      rpareto_tronque, param_forme,
                      param_dommages[2], franchise), sum) +
  mcsapply(mcsapply(as.list(touches23),
                      rpareto_tronque, param_forme,
                      param_dommages[3], franchise), sum) +
  mcsapply(mcsapply(as.list(touches24),
                      rpareto_tronque, param_forme,
                      param_dommages[4], franchise), sum)

dommages2_cum <- cumsum(dommages2)
dommages2_annuels <- diff(dommages2_cum[orages_annees_cum])

quantile(dommages2_annuels, c(0.5, 0.75, 0.9, 0.95, 0.99))

En comparant les deux jeux de résultats, tu peux observer l’impact direct de la concentration du risque sur les pertes attendues et les queues de distribution.

🌘 Risque associé au vol

Le vol est modélisé par une approche fréquence-sévérité classique, séparée en petits vols et grands vols.

🌘 Hypothèses

taux_vol_petits <- 1600 / 100000
taux_vol_grands <- 60 / 100000

On utilise une distribution de Poisson pour la fréquence et une distribution Gamma pour la sévérité.

vols_petits <- taux_vol_petits * n.assures
freq_vols_petits <- rpois(n.annees, vols_petits)
vols_petits_totaux <- sum(freq_vols_petits)
sev_vols_petits <- rgamma(vols_petits_totaux, 2, 0.005)
sev_vols_petits_cum <- cumsum(sev_vols_petits)
freq_petits_vols_cum <- cumsum(freq_vols_petits)
sev_vols_petits_annuels <- diff(sev_vols_petits_cum[freq_petits_vols_cum])

vols_grands <- taux_vol_grands * n.assures
freq_vols_grands <- rpois(n.annees, vols_grands)
vols_grands_totaux <- sum(freq_vols_grands)
sev_vols_grands <- rgamma(vols_grands_totaux, 2, 0.0001)
sev_vols_grands_cum <- cumsum(sev_vols_grands)
freq_grands_vols_cum <- cumsum(freq_vols_grands)
sev_vols_grands_annuels <- diff(sev_vols_grands_cum[freq_grands_vols_cum])

vols_totaux <- rowSums(cbind(sev_vols_petits_annuels,
                              sev_vols_grands_annuels))

Les quantiles de la distribution des pertes annuelles par vol :

quantile(vols_totaux, c(0.5, 0.75, 0.9, 0.95, 0.99))

🌘 Ce qu’il faut retenir

La modélisation par ellipses concentriques permet une détection simple et rapide des assurés touchés par un orage.
L’approche fréquence-sévérité pour le vol s’intègre naturellement dans le même cadre Monte Carlo.
La comparaison entre le groupe complet et le sous-groupe moins concentré illustre bien l’effet de la concentration du risque sur les pertes annuelles.

Tu peux retrouver l’ensemble des fichiers sources (code R, données, document Sweave) dans le dossier d’images de cet article et les adapter à tes propres données ou hypothèses.

La fonction mcsapply.R qui permet le calcul parallélisé est incluse dans le dossier. Pour l’utiliser, assure-toi d’avoir la librairie parallel chargée et d’exécuter le code sur un système qui supporte mclapply.

🌘 Version Quarto

Le document original a été converti au format Quarto moderne :