---
title: "Risque de concentration en Alberta"
author: "François Pelletier"
format:
  pdf:
    documentclass: article
    papersize: letter
    geometry:
      - margin=0.75in
    header-includes: |
      \usepackage{tikz}
      \usepackage{multirow}
      \usepackage{amsmath}
      \numberwithin{equation}{section}
      \usepackage{amsfonts}
      \usepackage{amsthm}
      \usepackage{thmtools}
      \usepackage{hyperref}
      \usepackage{cleveref}
      \usepackage[hypcap]{caption}
---

```{r}
#| label: librairie
#| echo: false
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 est un évènement de météo extrême qui peut créer beaucoup
de dommages dans une zone concentrée en peu de temps. Plusieurs facteurs
influencent la sévérité des dommages causés par ces tempêtes, dont le principal
est le diamètre moyen des grêlons. Le facteur influençant le nombre d'assurés
qui encourent un dommage est principalement la taille de l'orage de grêle et la
direction des vents.

J'ai choisi de modéliser les orages de grêle selon une force de 1 à 4, qui
influencera à la fois la taille moyenne de l'orage et la  taille des grêlons.
Afin de pouvoir obtenir facilement une formule analytique pour déterminer si un
assuré est touché par l'orage, j'ai choisi de lui donner une forme elliptique.
Ainsi, l'orage de force 4 sera formée de 4 ellipses concentriques, chacune ayant
un niveau de dommages allant de 1 à 4.

Je n'ai pas modélisé le lieu de formation des orages. Ainsi, un orage a la même
possibilité de se former à n'importe quel point à l'intérieur d'un rectangle
regroupant les assurés.

Les coordonnées en longitude et en latitude des assurés seront les seules
données utilisées ici.
La position des agents n'est pas nécessaire.
L'ensemble des montants et des paramètres des distributions statistiques ont été
attribués arbitraitement afin de donner des montants raisonnables à mon avis.

Enfin, afin de représenter le risque d'un assuré moins concentré, j'ai
simplement décidé de former un sous-groupe d'assurés formé d'un assuré sur
`r nb.conc` dans l'ordre fourni, ce qui a pour effet de diminuer la concentration
du risque tout en conservant l'effet de la densité de population, qui est déjà
concentrée sur le territoire.

### Définition des ellipses

L'ellipse est une section conique qui peut être représentée selon une formule
paramétrique [@eq-ellipse] qui sert à définir les
coordonnées en fonction des paramêtres. L'ellipse est alors définie par son
centre $X_c,Y_c$ et la mesure de son plus grand rayon $a$ et de son plus petit
rayon $b$, qui sont perpendiculaires. L'inclinaison du plus grand rayon par
rapport à l'abscisse est donnée par l'angle $\varphi$ en radian.

$$
\begin{aligned}
X(t)&=X_c + a\,\cos t\,\cos \varphi - b\,\sin t\,\sin\varphi\\
Y(t)&=Y_c + a\,\cos t\,\sin \varphi + b\,\sin t\,\cos\varphi
\end{aligned}
$$ {#eq-ellipse}

La formule canonique [@eq-canonique] est une seconde forme qui sert à
déterminer si un point $(x,y)$ fait partie de l'ellipse.

$$
\frac{\left((x-X_c)\cos \varphi-(y-Y_c)\sin \varphi\right)^2}{a^2} +
\frac{\left((x-X_c)\sin \varphi+(y-Y_c)\cos \varphi\right)^2}{b^2} = 1
$$ {#eq-canonique}

Ces deux dernières équations nous permettrons de simuler des ellipses,
représentant les orages, et de déterminer si des assurés sont touchés par les
orages. Les functions suivantes seront utilisées à cette fin:

```{r}
#| label: ellipse1
source("ellipse.R")
```

### Importation des données

On importe des données dans une structure

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

On visualise les données sur une carte. Les agents sont représentés par un
triangle rouge et les assurés par une croix noire.

```{r}
#| label: fig-carte
#| fig-cap: "Carte des assurés et des agents"
#| echo: false
plot(assures$Longitude_Assure,assures$Latitude_Assure,pch=3,
		main="Carte des assurés et des agents",xlab="Longitude",
		ylab="Latitude")
points(agents$Longitude_Agent,agents$Latitude_Agent,pch=25,
		col="red")
```

On définit la zone où se situent les assurés par un rectangle:

```{r}
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]))
```

On définit le groupe restreint pount l'évaluation avec moins de concentration

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

La longitude est située entre `r range_longitude[1]` et `r range_longitude[2]`.
La latitude est située entre `r range_latitude[1]` et `r range_latitude[2]`.

### Hypothèses

On pose plusieurs hypothèses de modélisation:

```{r}
franchise <- 500
n.annees <- 100
n.moyen.orages <- 10
longueur.orage <- 1
largeur.orage <- .2
angle.dominant <- 1/2
ecart.angle <- 1
prob_forces <- c(.8, .15, .04, .01)
facteur_forces <- c(1,1.5,2,2.5)
param_dommages <- c(50,1000,20000,400000)
param_forme <- 2
```

1.  La franchise est de `r franchise`$.
2.  Le nombre d'années simulées est de `r n.annees` années.
3.  Le nombre d'orages par année suit une loi Poisson de moyenne `r n.moyen.orages`.
4.  La longitude et la latitude du centre de l'orage sont distribués uniformément sur le rectangle défini précédemment.
5.  La longueur et la largeur suivent une loi exponentielle de paramètres `r 1/longueur.orage` et `r 1/largeur.orage`. L'unité est en degrés de latitude.
6.  Les vents dominants sont de direction `r angle.dominant` radians.
7.  L'angle varie dans un invervalle de `r ecart.angle` radian de part et d'autre selon la distribution $\beta\left(2,2\right)$.
8.  La force entre 1 et 4 suit une distribution discrète où les probabilités sont respectivement `r prob_forces[1]`, `r prob_forces[2]`, `r prob_forces[3]` et `r prob_forces[4]`.
9.  La force multiplie les dimensions de l'orage respectivement par `r facteur_forces[1]`, `r facteur_forces[2]`, `r facteur_forces[3]` et `r facteur_forces[4]`.
10. Les dommages suivent une distribution Pareto de paramètre de forme `r param_forme` et de paramètre d'échelle dépendant de la force, prenant les valeurs `r param_dommages[1]`, `r param_dommages[2]`, `r param_dommages[3]` et `r param_dommages[4]`.

### Simulation des orages

En utilisant les hypothèse définies précédemment, on simule des orages

```{r}
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 vérifie le nombre d'assurés touchés. On utilise une boucle
ici pour éviter de surcharger la mémoire vive. C'est plus rapide ainsi.

```{r}
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)
}

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])
```

On obtient une moyenne de `r mean(dommages_annuels)`, un écart-type de
`r sd(dommages_annuels)` et les quantiles suivants:

```{r}
quantile(dommages_annuels,c(.5,.75,.9,.95,.99))
```

### Comparaison avec moins de concentration

On sélectionne un assuré sur `r nb.conc` afin de réduire l'exposition et on
peut comparar les résultats avec les mêmes orages.

```{r}
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])
```

On obtient une moyenne de `r mean(dommages2_annuels)`, un écart-type de
`r sd(dommages2_annuels)` et les quantiles suivants:

```{r}
quantile(dommages2_annuels,c(.5,.75,.9,.95,.99))
```

## Risque associé au vol

```{r}
	taux_vol_petits <- 1600/100000
	taux_vol_grands <- 60/100000
```

### Hypothèses

Le risque associé au vol peut être modélisé à l'aide d'une approche
fréquence-sévérité régulière. On pose donc comme hypothèse une distrubution
poisson pour la fréquence et une distribution gamma pour la sévérité.
On divise les vols en petits vols et en grands vols.

```{r}
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,.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,.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))
```

On obtient une moyenne de vols annuels de `r mean(vols_totaux)` avec un
écart-type de `r sd(vols_totaux)`. Les quantiles de la distirubtion sont les
suivants:

```{r}
quantile(vols_totaux,c(.5,.75,.9,.95,.99))
```
