Pour le neuvième chapitre du cours d’actuariat de l’assurance non-vie à l’ENSAE, un petit fourre-tout avant d’attaquer la modélisation du passif, en parlant un peu de modèles Tweedie (modèle collectif vs. modèles individuels), de choix de variables, et de choix de modèles. Les slides sont en ligne (la version pdf téléchargeable est comme souvent plus complète que celle sur slideshare)
Tag Archives: Computer
How Could Classification Trees Be So Fast on Categorical Variables?
I think that over the past months, I have been saying non-correct things about classification with categorical covariates. Because I never took time to look at it carefuly. Consider some simulated dataset, with a logistic regression,
> n=1e3 > set.seed(1) > X1=runif(n) > q=quantile(X1,(0:26)/26) > q[1]=0 > X2=cut(X1,q,labels=LETTERS[1:26]) > p=exp(-.1+qnorm(2*(abs(.5-X1))))/(1+exp(-.1+qnorm(2*(abs(.5-X1))))) > Y=rbinom(n,size=1,p) > df=data.frame(X1=X1,X2=X2,p=p,Y=Y)
Here, we use some continuous covariate, except that
is considered as not-observed. Instead, we have a categorical covariate with 26 categories. The (theoretical) relationship between the covariate and the probability is given below,
> vx1=seq(0,1,by=.001) > vp=exp(-.1+qnorm(2*(abs(.5-vx1))))/(1+exp(-.1+qnorm(2*(abs(.5-vx1))))) > plot(vx1,vp,type="l")

and the empirical probability, for each modality is

If we run a classification tree, we get
> library(rpart) > tree=rpart(Y~X2,data=df) > library(rpart.plot) > prp(tree, type=2, extra=1)

To be more specific, the output is here
> tree
1) root 1000 249.90000 0.4900000
2) X2=F,G,H,I,J,K,L,M,N,O,P,Q,R 499 105.3 0.302
4) X2=J,K,L,M,N,O,P,Q,R 346 65.12 0.25144 *
5) X2=F,G,H,I 153 37.22876 0.4183007 *
3) X2=A,B,C,D,E,S,T,U,V,W,X,Y,Z 501 109.61 0.67
6) X2=B,C,D,E,S,T,U,V,W,X 385 90.38 0.623 *
7) X2=A,Y,Z 116 14.50862 0.8534483 *
Note that it takes less than a second to get that output. So clearly, we did not look for all combinations between modalities. For the first node, there are like possible groups, i.e.
> 67108864
It is big… not huge, but too big to try all combinations, since that’s only the first node, and we have to do it again on the two leaves, etc. Antoine (aka @ly_antoine) told me – while we were having a coffee after lunch today – the trick to get a fast algorithm, on categories. And as usual, the idea is very clever…
First, we need a function to compute Gini index
> gini=function(y,classe){
+ T=table(y,classe)
+ nx=apply(T,2,sum)
+ n=sum(T)
+ pxy=T/matrix(rep(nx,each=2),nrow=2)
+ omega=matrix(rep(nx,each=2),nrow=2)/n
+ g=-sum(omega*pxy*(1-pxy))
+ return(g)}
For the first node, the idea is very simple:
- Compute empirical averages
> cond_prob=aggregate(df$Y,by=list(df$X2),mean)
- Then sort those values,
,
- Based on that ordering, consider
> Group_Letters=cond_prob[order(cond_prob$x),2]

- Then consider (only)
possible partitions,
against
> v_gini=rep(NA,26)
> for(v in 1:26){
+ CLASSE=df$X2 %in% Group_Letters[1:v]
+ v_gini[v]=gini(y=df$Y,classe=CLASSE)
+ }
If we plot them, we get
> plot(1:26,v_gini,type="b)

As for continuous variables, we seek for the maximum value, and then, we have our two groups,

> sort(Group_Letters[1:which.max(v_gini)]) [1] F G H I J K L M N O P Q R
That’s exactly what we got with the tree function in R,
1) root 1000 249.90000 0.4900000 2) X2=F,G,H,I,J,K,L,M,N,O,P,Q,R 499 105.30 0.30
Now, consider the leaf on the left (for instance)
> sub_df=df[df$X2 %in% sort(Group_Letters[1:which.max(v_gini)]),]
Then use the same algorithm as before: sort the conditional means,
> cond_prob=aggregate(sub_df$Y,by= + list(sub_df$X2),mean) > s_Group_Letters=cond_prob[order(cond_prob$x),2]
Then compute Gini indices based on groups obtained from that ordering,
> v_gini=rep(NA,length(sub_Group_Letters))
> for(v in 1:length(sub_Group_Letters)){
+ CLASSE=sub_df$X2 %in% s_Group_Letters[1:v]
+ v_gini[v]=gini(y=sub_df$Y,classe=CLASSE)
+ }
If we plot it, we get our two groups,
> plot(1:length(s_Group_Letters),v_gini,type="b")

And the first group is here
> sort(sub_Group_Letters[1:which.max(v_gini)]) [1] J K L M N O P Q R
Again, that’s exactly what we got with the R function
1) root 1000 249.90000 0.4900000
2) X2=F,G,H,I,J,K,L,M,N,O,P,Q,R 499 105.30 0.30
4) X2=J,K,L,M,N,O,P,Q,R 346 65.12 0.25144 *
Clever, isn’t?
Inter-relationships in a matrix
Last week, I wanted to displaying inter-relationships between data in a matrix. My friend Fleur, from AXA, mentioned an interesting possible application, in car accidents. In car against car accidents, it might be interesting to see which parts of the cars were involved. On https://www.data.gouv.fr/fr/, we can find such a dataset, with a lot of information of car accident involving bodily injuries (in France, a police report is necessary, and all of them are reported in a big dataset… actually several dataset, with information of people involved, cars, locations, etc). For 2014 claims, the dataset is
> base = read.csv("https://www.data.gouv.fr/s/resources/base-de-donnees-accidents-corporels-de-la-circulation-sur-6-annees/20150806-153355/vehicules_2014.csv")
Let us keep only claims involving two vehicules,
> T=table(base$Num_Acc) > idx=names(T)[which(T==2)]
For 2014, we have 32,222 claims.
> length(idx) [1] 32222
In this dataset, we have information about where cars were hit,

plus ‘9’ for multiple hot (in rollover accidents) and ‘0’ should be missing information.
> nom=c("NA","Front","Front R",'Front L',"Back","Back R","Back L","Side R","Side L","Multiple")
Now, we simply have to go through our dataset, and get the matrix. My first idea was to get a symmetric one,
> B=base[base$Num_Acc %in% idx,]
> B=B[order(B$Num_Acc),]
> M=matrix(0,10,10)
> for(i in seq(1,nrow(B),by=2)){
+ a=B$choc[i]+1
+ b=B$choc[i+1]+1
+ M[a,b]=M[a,b]+1
+ M[b,a]=M[b,a]+1
+ }
> rownames(M)=nom
> colnames(M)=nom
The problem, when we ask for a symmetric chord diagram, is that we cannot have Front – Front claims (since values on the diagonal are removed)
> library(circlize) > chordDiagramFromMatrix(M,symmetric=TRUE)

So let’s pretend that there could be some possible distinction in the dataset, between the first and the second row. Like the first one is the ‘responsible’ driver. Or like, for insurer, the first one is your insured. Just to avoid this symmetry problem
> M=matrix(0,10,10)
> for(i in seq(1,nrow(B),by=2)){
+ a=B$choc[i]+1
+ b=B$choc[i+1]+1
+ M[a,b]=M[a,b]+1
+ }
> rownames(M)=paste("A",nom,sep=" ")
> colnames(M)=paste("B",nom,sep=" ")
If we visualize the chord diagram, this time it is more complex to analyze,
> chordDiagram(M)
Below we have the first row (say our driver, letter A) and on top, the second row (say the other driver, letter B),

In bodily injury claims, we observe a large proportion of Front – Front claims, as well as Front – Back. And as expected Back-Back are not that common….
De la réussite au brevet dans cinq collèges rennais
Ce matin, on a travaillé sur des données de réussite au brevet des collèges, sur Rennes (dans le cadre du cours de statistique). On dispose de données pour 5 collèges rennais, sur une douzaine d’années (entre 2001 et 2015).
- Analyse de le temps de l’agrégation des collèges
On avait commencé par quelque chose de simple: regarder l’évolution dans le temps du taux de réussite,
> base= + read.table( + "http://freakonometrics.free.fr/brevet_rennes.csv", header=TRUE,sep=";",dec=",") > idx=seq(4,ncol(base),by=3) > annees=as.numeric(substr(names(base)[idx],2,5)) > College=6 > plot(annees,base[College,idx],type="b")

Continue reading De la réussite au brevet dans cinq collèges rennais
De la fréquence des ouragans aux Etats-Unis
Pour la fin du cours de statistique, on joue enfin avec des données. Après les taux de réussite au brevet des collèges, on a travaillé un peu sur la survenance des ouragans aux Etats-Unis. La base utilisée est la suivante
> base=read.table( "http://freakonometrics.free.fr/ouragan.csv", sep=";",header=TRUE,dec=",") > base=base[1:207,1:7]
Le nombre annuel d’ouragan est la série suivante
> TB <- table(base$Year)
> years <- as.numeric(names(TB))
> counts <- as.numeric(TB)
> years0=(1900:2005)[which(!(1900:2005)%in%years)]
> db <- data.frame(years=c(years,years0),
counts=c(counts,rep(0,length(years0))))
> X=db$counts
> plot(db,type="h")

On peut comparer les fréquences observées avec ce que donnerait une loi de Poisson (paramètre obtenu par maximum de vraisemblance)
> lambda=mean(X) > n=length(X) > cbind(X,dpois(0:6,lambda)*n) [,1] [,2] 0 16 15.038430 1 34 29.367500 2 27 28.674870 3 13 18.665717 4 5 9.112744 5 6 3.559128 6 5 1.158396
On peut alors faire un test d’ajustement,
> library(vcd) > fit=goodfit(X,"poisson") > plot(fit)

> summary(fit)
Goodness-of-fit test for poisson distribution
X^2 df P(> X^2)
Likelihood Ratio 14.17686 5 0.01452415
On voit que le test d’ajustement d’une loi Poisson n’est pas très concluant ici. Notons que ni la loi binomiale
> fit=goodfit(X,"binomial")
> plot(fit)
> summary(fit)
Goodness-of-fit test for binomial distribution
X^2 df P(> X^2)
Likelihood Ratio 46.21196 5 8.222959e-09

ni la loi binomiale négative ne semble marcher.
> fit=goodfit(X,"nbinomial")
> plot(fit)
> summary(fit)
Goodness-of-fit test for nbinomial distribution
X^2 df P(> X^2)
Likelihood Ratio 10.91507 4 0.02753523

On peut faire un test de stabilité temporelle du paramètre d’une loi de Poisson, à l’aide du test de Przyborowski & Wilenski (1940). Un ancien package permettait de mettre en place ce test. Mais on peut heureusement utiliser une autre fonction, avec une version différente du test (on pourra aussi consulter Krishnamoorthy & Thomson (2004) pour aller plus loin). L’idée du premier test est assez simple: notons que si sur la première période (de durée ), on a un processus de Poisson de paramètre
et
sur la seconde période (de durée
), alors
et
Un test de s’écrit
Notons que la loi
conditionnelle de sachant
suit une loi binomiale, donc le paramètre de probabilité est fonction de ce ratio. Plus précisément, conditionnellement à
,
suit un loi binomiale
avec
A partir de là, il est facile de mettre en place une stratégie de test. Une autre stratégie est d’utiliser
> seuil=1960 > X1=db[db$years<seuil,"counts"] > X2=db[db$years>=seuil,"counts"] > N1=length(db$years<seuil) > N2=length(db$years>=seuil) > poisson.test(c(sum(X1),sum(X2)),c(N1,N2)) Comparison of Poisson rates data: c(sum(X1), sum(X2)) time base: c(N1, N2) count1 = 85, expected count1 = 103.5, p-value = 0.01216 alternative hypothesis: true rate ratio is not equal to 1 95 percent confidence interval: 0.5218662 0.9265666 sample estimates: rate ratio 0.6967213
Bref, on peut accepter que le nombre annuel d’ouragan n’est pas un processus de Poisson homogène dans le temps…
Autres Données pour le cours de Statistiques
Encore quelques données pour faire un TP de statistique. Ce sont des données de coûts d’ouragans, aux Etats-Unis,
> library(gdata)
> db=read.xls(
+ "http://sciencepolicy.colorado.edu/publications/special/public_data_may_2007.xls",
+ sheet=1)
> stupidcomma = function(x){
+ x=as.character(x)
+ for(i in 1:10){x=sub(",","",as.character(x))}
+ return(as.numeric(x))}
> base=db[,1:4]
> base$Base.Economic.Damage=
Vectorize(stupidcomma)(db$Base.Economic.Damage)
> base$Normalized.PL05=Vectorize(stupidcomma)(db$Normalized.PL05)
> base$Normalized.CL05=Vectorize(stupidcomma)(db$Normalized.CL05)
Lire la base est un peu pénible, à cause de virgules qui traînent comme séparateur de milliers. Mais peu importe, le petit code permet de nettoyer la base.
- Fréquence d’ouragans
La première étape pourra être de travailler sur la fréquence. On pourra ajuster des lois de Poisson, ou binomiales, ou binomiales négatives, et faire des tests de stabilité du paramètre, avec le temps (on pourra couper en 4 ou 5 blocs).
> TB <- table(base$Year) > years <- as.numeric(names(TB)) > counts <- as.numeric(TB) > years0=(1900:2005)[which(!(1900:2005)%in%years)] > db <- data.frame(years=c(years,years0), + counts=c(counts,rep(0,length(years0)))) > db[88:93,] years counts 88 2003 3 89 2004 6 90 2005 6 91 1902 0 92 1905 0 93 1907 0 > plot(years,counts,type='h')

- Coût des ouragans
Dans un second temps, on pourra travailler sur le coût des ouragans
> plot(base$Normalized.PL05/1e9,type="h")

On pourra tenter d’ajuster des lois, log normale, gamma, Pareto, etc. Faire des tests d’ajustement. Et tester la stabilité des paramètres, dans le temps (en coupant en 2 blocs, par exemple, ou davantage).
Actuariat de l’Assurance Non-Vie #7
Pour le septième chapitre du cours d’actuariat de l’assurance non-vie à l’ENSAE, on abordera la modélisation des coûts individuels, aussi bien dommage que responsabilité civile.. Les slides sont en ligne (la version pdf téléchargeable est comme souvent plus complète que celle sur slideshare)
Actuariat de l’Assurance Non-Vie #5
Pour le quatrième cours d’actuariat de l’assurance non-vie à l’ENSAE, la semaine prochaine, on abordera la notion de sur-dispersion dans les modèles de comptage. Les slides sont en ligne (la version pdf téléchargeable est plus complète que celle sur slideshare)
Actuariat de l’Assurance Non-Vie #4
Pour le troisième cours d’actuariat de l’assurance non-vie à l’ENSAE, on abordera la théorie des modèles linéaires généralisés Les slides sont en ligne (la version pdf téléchargeable est plus complète que celle sur slideshare)
Actuariat de l’Assurance Non-Vie #2
Pour le second cours d’actuariat de l’assurance non-vie à l’ENSAE, qui aura lieu lundi après midi, les slides présentant les modèles classiques pour prédire des variables factorielles (classification) sont en ligne,
Big Data and Machine Learning with an Actuarial Perspective
Next week, I will give a (one day) crash course at the IA | BE Sumer School, in Louvain-la-Neuve. Slides are available on the blog.
Petit exercice de proba
Mardi dernier, on avait fait une série d’exercices de proba, et je voulais reprendre un exercice pour lequel j’avais proposé une vérification sur ordinateur.

Pour résoudre l’exercice, j’avais suggéré la méthode suivante. est tiré parmi
, alors que
est tiré parmi
. On note assez facilement que le plus petit nombre est
, et comme le ppcm de
et
est
,
(je laisse faire les calculs pour montrer qu’effectivement, au delà, on n’est plus dans les ensembles de départ). Bref, seuls nombres figurent dans les deux ensembles. La probabilité que l’on cherche est alors donnée par
où on somme sur nos nombres. On a alors
où chacune des probabilités vaut (on a une chance sur
de tomber sur n’importe quel nombre), et on a une somme de
termes. Donc la probabilité que l’on cherche est
Pour le vérifier, on peut utiliser le petit code (R) suivant
> list_X=seq(2,by=3,length=100) > list_Y=seq(3,by=4,length=100) > n=1e8 > x=sample(list_X,size=n,replace=TRUE) > y=sample(list_Y,size=n,replace=TRUE) > sum(x==y)/n [1] 0.00250221
qui confirme le petit calcul que l’on vient de faire.
Construction de cartes minimalistes
Le week-end passé, suite à la publication de See the world differently with these minimalist maps par Matthew Champion, il y a eu pas mal d’activité autour des cartes minimalistes. En particulier, Reka (aka @visionscarto) et Philippe (aka @recifs) m’ont proposé de faire un billet pour Visions Carto sur la construction de ces cartes. Je suis flatté, même si je trouve ma contribution incroyablement modeste sur ce projet (et je me sens toujours humble face aux dessins superbes de Reka).

Je renvoie donc vers le billet Cartes Minimalistes pour plus de détails, mais pour les plus curieux, je rajoute deux cartes, plus française. La première correspond aux voies ferroviaires,
library(maptools)
setwd("/home/freakonometrics/Documents/data")
loc="http://www.mapcruzin.com/download-shapefile/france-railways-shape.zip"
download.file(loc,destfile="rail_france.zip")
unzip("rail_france.zip", exdir="./rail_france/")
shap=readShapeLines("./rail_france/railways.shp")
plot(shap,lwd=.7)

et la seconde, aux routes dans la région parisienne,
loc="http://www.mapcruzin.com/download-shapefile/france-roads-shape.zip"
download.file(loc,destfile="road_france.zip")
unzip("road_france.zip", exdir="./road_france/")
shap=readShapeLines("./road_france/roads.shp")
plot(shap,lwd=.7,ylim=48.85+c(-.5,.5),
xlim=2.35+c(-.5,.5))

La prochaine fois, j’expliquerais un peu comment corriger les shapefiles quand on a des soucis avec (je repense au commentaire qui disait que qu’il était dommage d’avoir une route entre le Royaume Uni et l’Islande).
Pricing Game
In November, with Romuald Elie and Jérémie Jakubowicz, we will organize a session during the 100% Actuaires day, in Paris, based on a “pricing game“. We provide two datasets, (motor insurance, third party claims), with 2 years of experience, and 100,000 policies. Each ‘team’ has to submit premium proposal for 36,000 potential insured for the third year (third party, material + bodily injury).
We will work as a ‘price aggergator’ with all the teams, with simple matching rules (the cheapest is chosen, or more complex rules, based on random selection among cheap insurers). The complete description is available on line.
R codes to read the datasets are
> training <- read.csv2( + "http://freakonometrics.free.fr/training.csv") > dim(training) [1] 100021 20 > pricing <- read.csv2( + "http://freakonometrics.free.fr/pricing.csv") > dim(pricing) [1] 36311 15
Everyone is invited to play! The more, the merrier….
Visualising Claims Frequency
A few years ago, I did publish a post to visualize and empirical claims frequency in a portfolio. I wanted to update the code.