Freakonometrics

To content | To menu | To search

Tuesday, December 6 2011

ACT2040: de la robustesse des arbres

Pour répondre à une question rapide, la robustesse des arbres dépend de deux choses: du nombre d'observations (plus il y a d'observations, plus les nœuds seront stables), et de l'hétérogénéité entre les classes (plus les classes sont différentes, plus il sera facile de les distinguer). Pour faire simple, considérons un petit modèle binomial à trois classes (avec une unique variable explicative), par exemple si on simule 1000 valeurs,

m=c(.2,.5,.3)
moyenne=function(x){
return(m[1]*(x<3)+m[2]*((x>=3)&(x<=7))+m[3]*(x>7))
}
MY=Vectorize(moyenne)
set.seed(1)
n=1000
U=runif(n)*10
Y=rbinom(n,size=1,prob=MY(U))
plot(U,Y,ylim=c(-.1,1.1))
library(splines)
base=data.frame(Y,U)
reg=glm(Y~bs(U,10),data=base,family=binomial)
u=seq(0,10,by=.01)
y=predict(reg,newdata=data.frame(U=u),type="response")
lines(u,y,lwd=2,col="blue")
lines(u,MY(u),lwd=2,col="red",type="s")

Si on simule quelques milliers d'échantillons, on peut regarder la distribution de mes nœuds (si le découpage par arbre converge), en gardant - au mieux - que deux nœuds,

set.seed(1)
N=matrix(NA,10000,2)
n=1000
for(s in 1:1000){
U=runif(n)*10
Y=rbinom(n,size=1,prob=MY(U))
T=tree(Y~U)
noeud=T$frame$splits[,1]
noeud=noeud[noeud!=""]
NOEUD=as.numeric(substr(noeud,2,nchar(noeud)))
N[s,]=NOEUD[1:2]
}
vn=as.vector(N)
vn=vn[is.na(vn)==FALSE]
plot(density(vn,bw=.2),col="blue",lwd=2,xlim=c(0,10))
abline(v=c(3,7),col="red")

Rappelons que l'on a ici 1000 observations pour faire notre régression, avec trois classes, dont les valeurs moyennes par classe sont respectivement 20%, 50% et 30%. On note que l'on coupe bien entre les deux premières classes, un peu moins bien entre les deux dernières.

Si on suppose que les classes sont moins différentes, par exemple avec des valeurs moyennes à 30%, 50% et 40%, on obtient visuellement la distribution suivante pour les nœuds,

En l’occurrence, on a beaucoup de mal à distinguer entre les deux dernières classes.

Si on change la taille de notre échantillon, en passant de 1000 à 200, on s'aperçoit (en revenant aux valeurs précédentes des taux par classes) que l'on a beaucoup de mal à estimer correctement les nœuds,

De manière assez surprenante, il va prendre des nœuds proches des bords (proches de 0 et de 10).

Moralité, les classes obtenues par arbre ne sont robustes qu'à condition d'avoir suffisamment d'observations, et d'avoir des classes réellement différentes.

Wednesday, November 30 2011

ACT2040: une région géographique n'est pas une variable continue

En relisant les devoirs maisons, je me suis rendu compte que certains avaient tenté de regrouper les régions (géographiques) par régions homogènes. Sauf que les régions étaient codées par un numéro (selon la codification officielle). Par exemple, dans une des bases, nous avions des assurés dans 4 zones géographiques, à savoir la région 82 (région Rhône-Alpes en rouge) la région 54 (région Poitou-Charentes en vert) la région 73 (région Midi-Pyrénées en bleu) et enfin la région 41 (région Lorraine en mauve).

> unique(baseFREQ$region)
[1] 82 54 73 41

Une idée intéressante pour regrouper les régions pouvait être d'utiliser les arbres. Les régions étant des couleurs (on le voit bien sur la carte) et pas des variables quantitatives, il est normal de travailler sur des facteurs. D'ailleurs le code pour faire la carte est le suivant,

> library(maps)
>  france<-map(database="france")
>  dpt=c("Ain","Ardeche","Drome","Isere","Loire ","Rhone",
+ "Savoie","Haute-Savoie","Charente","Charente-Maritime",
+ "Deux-Sevres","Vienne","Ariege","Aveyron","Haute-Garonne",
+ "Gers","Lot","Hautes-Pyrenees","Tarn","Tarn-et-Garonne",
+ "Meurthe-et-Moselle","Meuse","Moselle","Vosges")
>  couleur=c(rep(2,8),rep(3,4),rep(4,8),rep(6,4))
>  match=match.map(france,dpt)
>  color=couleur[match]
>  map(database="france", fill=TRUE, col=color)

L'arbre sur les régions en tant que facteurs donne le découpage suivant

>  baseFREQ$fregion=as.factor(baseFREQ$region)
>  ARBRE1=tree(nombre~fregion,data=baseFREQ,split="gini")
>  plot(ARBRE1)
>  text(ARBRE1)

Bon, R a la mauvaise idée de recoder les classes (mais il garde l'ordre, i.e. a correspond à la région 41, b à 54, c à 73 et d à 82). Visuellement, on retient qu'il est possible de considérer deux grandes régions, ac (i.e. 41 et 73) et bd (i.e. 54 et 72). L'intérêt des arbres sur des variables qualitatives, des facteurs, c'est que tous les regroupements sont possibles. En revanche, si on fait un arbre sur la région qui est lue en tant que nombre (quantitatif), on obtient

>  ARBRE2=tree(nombre~region,data=baseFREQ,split="gini")
>  plot(ARBRE2)
>  text(ARBRE2)

Il est alors impossible de regrouper dans une même classe deux régions séparées par un nombre, i.e. on ne peut regrouper 41 et 82 dans la même classe. R suggère de distinguer peut être trois régions, à savoir 82 (à droite), puis 73 (au centre) et enfin de mettre éventuellement 41 et 54 ensemble. Ce qui n'est pas la stratégie optimale quand on regroupe des facteurs.

Thursday, November 10 2011

ACT2040: sélection de variables versus sélection de modalités

En cours, nous avions évoqué (très rapidement) la sélection automatique de variables. La méthode la plus simple est une méthode stepwise, basé sur un critère de type AIC, ou BIC. Considérons la base suivante,

>  N = base$nbre
>  E = base$exposition
>  X1 = base$carburant
>  X2 = cut(base$agevehicule,c(0,3,10,101),
+ right=FALSE)
>  X3 = cut(base$ageconducteur,c(0,22,45,101),
+ right=FALSE)
>  X4 = as.factor(base$zone)
>  X5 = as.factor(base$puissance)
>  X6 = as.factor(base$region)
>  X7 = as.factor(base$marque)
>  base1=data.frame(N,E,X1,X2,X3,X4,X5,X6,X7)

Une méthode stepwise (backward) donne ici

> reg1=glm(N~X1+X2+X3+X4+X5+X6+X7+offset(log(E)),
+ family="poisson",data=base1)
> step(reg1)
Start:  AIC=20492.67
N ~ X1 + X2 + X3 + X4 + X5 + X6 + X7 + offset(log(E))
 
Df Deviance   AIC
- X5   11    15316 20482
- X3    2    15305 20490
<none>       15304 20493
- X2    2    15314 20499
- X1    1    15319 20506
- X7   10    15343 20511
- X4    5    15398 20576
- X6   14    15569 20729
 
Step:  AIC=20482.35
N ~ X1 + X2 + X3 + X4 + X6 + X7 + offset(log(E))
 
Df Deviance   AIC
- X3    2    15317 20479
<none>       15316 20482
- X2    2    15326 20488
- X1    1    15334 20498
- X7   10    15359 20505
- X4    5    15410 20566
- X6   14    15579 20717
 
Step:  AIC=20479.33
N ~ X1 + X2 + X4 + X6 + X7 + offset(log(E))
 
Df Deviance   AIC
<none>       15317 20479
- X2    2    15327 20485
- X1    1    15334 20495
- X7   10    15360 20502
- X4    5    15410 20563
- X6   14    15620 20754
 
Call:  glm(formula = N ~ X1 + X2 + X4 + X6 + X7 
+
offset(log(E)),
 family = "poisson", data = base1)   Coefficients: (Intercept) X1E X2[3,10) X2[10,101) X4B -1.0588454 -0.1653822 0.0266763 -0.1135451 -0.0004047 X4C X4D X4E X4F X60 0.1497622 0.3748811 0.5052894 0.4292016 -0.3590838 X61 X62 X63 X64 X65 -0.9300641 -1.0278887 -1.1818218 -1.0971797 -0.9459414 X66 X67 X68 X69 X610 -1.3690795 -1.1425678 -1.5309402 -1.3883549 -1.4603624 X611 X612 X613 X72 X73 -1.6763206 -1.3974092 -1.4864404 0.0246113 0.1144990 X74 X75 X76 X710 X711 -0.0932555 0.1635397 -0.1478095 0.2502030 0.1967970 X712 X713 X714 -0.2420215 0.2161411 -0.1963162   Degrees of Freedom: 49999 Total (i.e. Null); 49967 Residual Null Deviance: 15810 Residual Deviance: 15320 AIC: 20480

Autrement dit, on supprime la troisième (âge du conducteur principal, par classes arbitraires) et la cinquième variable (puissance du véhicule) en gardant toutes les autres. Mais ici, si une variable n'a pas été retenue, c'est que globalement, elle n'apportait pas beaucoup d'information. Il serait toutefois possible de garder une information partielle, en gardant éventuellement certaines modalités. L'idée est de disjoncter la base, en créant des variables indicatrices par modalités. La base sera beaucoup plus grosse, et la sélection prendra alors beaucoup plus de temps,

> base2=data.frame(model.matrix( ~ 0+X1+X2+X3+X4+X5+X6+X7,
+ data=base1)) > base2$E=base1$E > base2$N=base1$N > reg2=glm(N~.-E+offset(log(E)),family="poisson", + data=base2) > step(reg2) Start: AIC=20492.67 N ~ (X1D + X1E + X2.3.10. + X2.10.101. + X3.22.45. + X3.45.101. X4B + X4C + X4D + X4E + X4F + X55 + X56 + X57 + X58 + X59 + X510 + X511 + X512 + X513 + X514 + X515 + X60 + X61 + X62 + X63 + X64 + X65 + X66 + X67 + X68 + X69 + X610 + X611 + X612 + X613 + X72 + X73 + X74 + X75 + X76 + X710 + X711 + X712 + X713 + X714 + E) - E + offset(log(E))     Step: AIC=20492.67 N ~ X1D + X2.3.10. + X2.10.101. + X3.22.45. + X3.45.101. + X4B X4C + X4D + X4E + X4F + X55 + X56 + X57 + X58 + X59 + X510 + X511 + X512 + X513 + X514 + X515 + X60 + X61 + X62 + X63 + X64 + X65 + X66 + X67 + X68 + X69 + X610 + X611 + X612 + X613 + X72 + X73 + X74 + X75 + X76 + X710 + X711 + X712 + X713 + X714 + offset(log(E))   Df Deviance AIC - X4B 1 15304 20491 - X58 1 15304 20491 - X511 1 15304 20491 - X2.3.10. 1 15304 20491 - X72 1 15304 20491 - X513 1 15304 20491 - X512 1 15304 20491 - X515 1 15304 20491 - X74 1 15305 20491 - X3.45.101. 1 15305 20491 - X714 1 15305 20491 - X55 1 15305 20492 - X3.22.45. 1 15305 20492 - X711 1 15306 20492 - X76 1 15306 20492 - X59 1 15306 20492 <none> 15304 20493 - X514 1 15306 20493 - X713 1 15306 20493 - X73 1 15307 20493 - X56 1 15307 20493 - X710 1 15307 20494 - X75 1 15308 20494 - X2.10.101. 1 15308 20495 - X57 1 15309 20495 - X4C 1 15310 20496 - X510 1 15310 20496 - X60 1 15312 20498 - X4F 1 15314 20500 - X712 1 15316 20503 - X1D 1 15319 20506 - X4D 1 15337 20524 - X61 1 15345 20532 - X65 1 15350 20536 - X62 1 15352 20538 - X64 1 15359 20545 - X4E 1 15362 20549 - X63 1 15366 20553 - X67 1 15370 20556 - X612 1 15381 20568 - X69 1 15382 20569 - X66 1 15387 20574 - X610 1 15389 20576 - X68 1 15393 20580 - X611 1 15406 20592 - X613 1 15451 20637   Step: AIC=20490.67 N ~ X1D + X2.3.10. + X2.10.101. + X3.22.45. + X3.45.101. + X4C X4D + X4E + X4F + X55 + X56 + X57 + X58 + X59 + X510 + X511 + X512 + X513 + X514 + X515 + X60 + X61 + X62 + X63 + X64 + X65 + X66 + X67 + X68 + X69 + X610 + X611 + X612 + X613 + X72 + X73 + X74 + X75 + X76 + X710 + X711 + X712 + X713 + X714 + offset(log(E))

etc etc... et si on va directement à la fin,

Step:  AIC=20469.18
N ~ X1D + X2.10.101. + X4C + X4D + X4E + X4F + X57 + X510 + X60
X61 + X62 + X63 + X64 + X65 + X66 + X67 + X68 + X69 + X610 +
X611 + X612 + X613 + X73 + X75 + X76 + X710 + X712 + X713 +
offset(log(E))
 
Df Deviance   AIC
<none>             15315 20469
- X76         1    15317 20470
- X713        1    15317 20470
- X73         1    15317 20470
- X57         1    15318 20470
- X75         1    15318 20471
- X710        1    15319 20471
- X510        1    15319 20471
- X4C         1    15322 20474
- X60         1    15322 20475
- X2.10.101.  1    15325 20478
- X4F         1    15325 20478
- X1D         1    15333 20485
- X712        1    15338 20490
- X61         1    15356 20508
- X4D         1    15359 20511
- X62         1    15363 20515
- X65         1    15363 20515
- X64         1    15371 20524
- X63         1    15378 20530
- X67         1    15383 20536
- X4E         1    15390 20543
- X612        1    15394 20547
- X69         1    15396 20548
- X66         1    15400 20553
- X610        1    15403 20555
- X68         1    15407 20559
- X611        1    15419 20572
- X613        1    15467 20619
 
Call:  glm(formula = N ~ X1D + X2.10.101. + X4C + X4D + X4E + X4F
X57 + X510 + X60 + X61 + X62 + X63 + X64 + X65 + X66 + X67 +
X68 + X69 + X610 + X611 + X612 + X613 + X73 + X75 + X76 +
X710 + X712 + X713 + offset(log(E)), family = "poisson",
data = base2)
 
Coefficients:
(Intercept)          X1D   X2.10.101.          X4C          X4D
-1.20880      0.16886     -0.13808      0.14888      0.37539
X4E          X4F          X57         X510          X60
0.50458      0.42768      0.08381      0.18722     -0.36509
X61          X62          X63          X64          X65
-0.93836     -1.03471     -1.18803     -1.10217     -0.95624
X66          X67          X68          X69         X610
-1.37463     -1.15391     -1.54213     -1.40188     -1.47217
X611         X612         X613          X73          X75
-1.68559     -1.40582     -1.49700      0.10874      0.15022
X76         X710         X712         X713
-0.15183      0.21948     -0.27400      0.19565
 
Degrees of Freedom: 49999 Total (i.e. Null);  49971 Residual
Null Deviance:	    15810
Residual Deviance: 15310 	AIC: 20470 

Si la troisième variable (âge du conducteur principal, par classes arbitraires) disparait assez vite, en revanche, une information sur la cinquième (la puissance) est gardée car certaines modalités semblent être informative sur la fréquence d'accidents. En revanche, on notera qui si on fait un arbre, la troisième variable était toujours clairement significative, ce qui peut nous conforter dans l'idée de faire de la sélection de variables sur les modalités.

> library(tree)
> TREE= tree(N~X1+X2+X3+X4+X5+X6+X7+offset(log(E)),split="gini",
+
mincut = 2500,data=base1) > plot(TREE) > text(TREE,cex=.9)

Wednesday, October 26 2011

ACT2040, régression sur des variables catégorielles (facteurs)

Petit complément par rapport au cours de mardi. On avait évoqué tout d'abord la lecture des sorties lorsque l'on régresse sur des variables catégorielles (des facteurs). Commençons par supprimer la constante de la régression
> reg0=glm(nbre~0+zone,offset=log(exposition),data=base, 
+
family=poisson(link="log"))
> summary(reg0)
 
Call:
glm(formula = nbre ~ 0 + zone, family = poisson(link = "log"),
data = base, offset = log(exposition))
 
Deviance Residuals:
Min 1Q Median 3Q Max
-0.5717 -0.3968 -0.2996 -0.1547 12.6722
 
Coefficients:
Estimate Std. Error z value Pr(>|z|)
zoneB -2.54187 0.06287 -40.43 <2e-16 ***
zoneA -2.54912 0.05285 -48.23 <2e-16 ***
zoneC -2.38525 0.03753 -63.56 <2e-16 ***
zoneD -2.13454 0.03878 -55.05 <2e-16 ***
zoneE -2.00204 0.03965 -50.49 <2e-16 ***
zoneF -2.06932 0.11547 -17.92 <2e-16 ***
---
Signif. codes: 0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1
 
(Dispersion parameter for poisson family taken to be 1)
 
Null deviance: 50966 on 50000 degrees of freedom
Residual deviance: 15692 on 49994 degrees of freedom
AIC: 20800
 
Number of Fisher Scoring iterations: 6
 
> predict(reg0,newdata=data.frame(
+
zone=c("A","B","C","D","E"),exposition=rep(1,5)))
1 2 3 4 5
-2.549120 -2.541870 -2.385253 -2.134543 -2.002044
On voit que toutes les modalités sont présentes, et toutes sont significatives. Si on régresse sur la constante, il faudra supprimer une modalité pour rendre le modèle identifiable. On peut forcer pour que la modalité de référence soit la seconde,
> base$zone=relevel(base$zone,"B")
> regB=glm(nbre~zone,offset=log(exposition),data=base,
+ family=poisson(link="log"))
> summary(regB)
 
Call:
glm(formula = nbre ~ zone, family = poisson(link = "log"), 
data = base, offset = log(exposition))   Deviance Residuals: Min 1Q Median 3Q Max -0.5717 -0.3968 -0.2996 -0.1547 12.6722   Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -2.54187 0.06287 -40.431 < 2e-16 *** zoneA -0.00725 0.08213 -0.088 0.929661 zoneC 0.15662 0.07322 2.139 0.032432 * zoneD 0.40733 0.07387 5.514 3.50e-08 *** zoneE 0.53983 0.07433 7.263 3.80e-13 *** zoneF 0.47255 0.13148 3.594 0.000325 *** --- Signif. codes: 0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1   (Dispersion parameter for poisson family taken to be 1)   Null deviance: 15809 on 49999 degrees of freedom Residual deviance: 15692 on 49994 degrees of freedom AIC: 20800   Number of Fisher Scoring iterations: 6   > predict(regB,newdata=data.frame( + zone=c("A","B","C","D","E"),exposition=rep(1,5))) 1 2 3 4 5 -2.549120 -2.541870 -2.385253 -2.134543 -2.002044
On notera que les prédictions ne changent pas. On peut aussi choisir la première comme modalité de référence,
> base$zone=relevel(base$zone,"A")
> reg=glm(nbre~zone,offset=log(exposition),
> data=base,family=poisson(link="log"))
> summary(reg)
 
Call:
glm(formula = nbre ~ zone, family = poisson(link = "log"), 
data = base, offset = log(exposition))   Deviance Residuals: Min 1Q Median 3Q Max -0.5717 -0.3968 -0.2996 -0.1547 12.6722   Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) -2.54912 0.05285 -48.232 < 2e-16 *** zoneB 0.00725 0.08213 0.088 0.929661 zoneC 0.16387 0.06482 2.528 0.011471 * zoneD 0.41458 0.06555 6.324 2.54e-10 *** zoneE 0.54708 0.06607 8.280 < 2e-16 *** zoneF 0.47980 0.12699 3.778 0.000158 *** --- Signif. codes: 0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1   (Dispersion parameter for poisson family taken to be 1)   Null deviance: 15809 on 49999 degrees of freedom Residual deviance: 15692 on 49994 degrees of freedom AIC: 20800   Number of Fisher Scoring iterations: 6
Le fait que la seconde modalité ne soit pas significative se lit par rapport à la modalité de référence (en l’occurrence la première): non significatif signifie alors non significativement différente. Autrement dit, on peut regrouper les modalités en une seule.
> base$zonesimple=base$zone
> base$zonesimple[base$zone%in%c("A","B")]="A"
> reg=glm(nbre~zonesimple,offset=log(exposition),
+ data=base,family=poisson(link="log"))
> summary(reg)
 
Call:
glm(formula = nbre ~ zonesimple, family = poisson(link = "log"),
data = base, offset = log(exposition))
 
Deviance Residuals:
Min       1Q   Median       3Q      Max
-0.5717  -0.3959  -0.2989  -0.1547  12.6722
 
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.54612    0.04046 -62.937  < 2e-16 ***
zonesimpleC  0.16087    0.05518   2.915  0.00355 **
zonesimpleD  0.41158    0.05604   7.345 2.06e-13 ***
zonesimpleE  0.54408    0.05665   9.605  < 2e-16 ***
zonesimpleF  0.47681    0.12235   3.897 9.74e-05 ***
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1
 
(Dispersion parameter for poisson family taken to be 1)
 
Null deviance: 15809  on 49999  degrees of freedom
Residual deviance: 15692  on 49995  degrees of freedom
AIC: 20798
 
Number of Fisher Scoring iterations: 6
On note qu'avec ce regroupement, les autres modalités sont sensiblement différentes. On peut aussi retenir la troisième comme modalité de référence
> base$zonesimple=relevel(base$zonesimple,"C")
> reg=glm(nbre~zonesimple,offset=log(exposition),
+ data=base,family=poisson(link="log"))
> summary(reg)
 
Call:
glm(formula = nbre ~ zonesimple, family = poisson(link = "log"),
data = base, offset = log(exposition))
 
Deviance Residuals:
Min       1Q   Median       3Q      Max
-0.5717  -0.3959  -0.2989  -0.1547  12.6722
 
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.38525    0.03753 -63.557  < 2e-16 ***
zonesimpleA -0.16087    0.05518  -2.915  0.00355 **
zonesimpleD  0.25071    0.05396   4.646 3.39e-06 ***
zonesimpleE  0.38321    0.05460   7.019 2.24e-12 ***
zonesimpleF  0.31593    0.12142   2.602  0.00927 **
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1
 
(Dispersion parameter for poisson family taken to be 1)
 
Null deviance: 15809  on 49999  degrees of freedom
Residual deviance: 15692  on 49995  degrees of freedom
AIC: 20798
 
Number of Fisher Scoring iterations: 6
Comme toutes les modalités semblent significatives, on peut tenter de prendre comme modalité de référence une des dernières (dont les estimations des coefficients donnent des résultats très proches)
> base$zonesimple=relevel(base$zonesimple,"F")
> reg=glm(nbre~zonesimple,offset=log(exposition),
+ data=base,family=poisson(link="log"))
> summary(reg)
 
Call:
glm(formula = nbre ~ zonesimple, family = poisson(link = "log"),
data = base, offset = log(exposition))
 
Deviance Residuals:
Min       1Q   Median       3Q      Max
-0.5717  -0.3959  -0.2989  -0.1547  12.6722
 
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.06932    0.11547 -17.921  < 2e-16 ***
zonesimpleC -0.31593    0.12142  -2.602  0.00927 **
zonesimpleA -0.47681    0.12235  -3.897 9.74e-05 ***
zonesimpleD -0.06522    0.12181  -0.535  0.59232
zonesimpleE  0.06727    0.12209   0.551  0.58161
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1
 
(Dispersion parameter for poisson family taken to be 1)
 
Null deviance: 15809  on 49999  degrees of freedom
Residual deviance: 15692  on 49995  degrees of freedom
AIC: 20798
 
Number of Fisher Scoring iterations: 6
Au vue de cette dernière sortie, on peut tenter de fusionner toutes les dernières classes ensembles
> base$zonesimple[base$zone%in%c("D","E","F")]="F"
> reg=glm(nbre~zonesimple,offset=log(exposition),
+ data=base,family=poisson(link="log"))
> summary(reg)
 
Call:
glm(formula = nbre ~ zonesimple, family = poisson(link = "log"),
data = base, offset = log(exposition))
 
Deviance Residuals:
Min       1Q   Median       3Q      Max
-0.5660  -0.3959  -0.3004  -0.1547  12.5929
 
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.07182    0.02696 -76.853  < 2e-16 ***
zonesimpleC -0.31344    0.04621  -6.783 1.18e-11 ***
zonesimpleA -0.47431    0.04861  -9.757  < 2e-16 ***
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1
 
(Dispersion parameter for poisson family taken to be 1)
 
Null deviance: 15809  on 49999  degrees of freedom
Residual deviance: 15698  on 49997  degrees of freedom
AIC: 20800
 
Number of Fisher Scoring iterations: 6
Bon, formellement, regrouper deux modalités (i.e. décréter que deux variables sont non significatives simultanément) demande un peu plus qu'un test de Student, ou que deux tests de Student.... Si on remonte un peu en arrière, on aurait pu faire un test multiple avant de fusionner les trois modalités (un test de type Fisher, ou une ANOVA)
> base$zonesimple=relevel(base$zonesimple,"F")
> reg=glm(nbre~zonesimple,offset=log(exposition),
+ data=base,family=poisson(link="log"))
> library(car)
> linearHypothesis(reg,c("zonesimpleD=0","zonesimpleE=0"))
Linear hypothesis test
 
Hypothesis:
zonesimpleD = 0
zonesimpleE = 0
 
Model 1: restricted model
Model 2: nbre ~ zonesimple
 
Res.Df Df  Chisq Pr(>Chisq)
1  49997
2  49995  2 5.7073    0.05763 .
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1 
Manifestement, on peut accepter l'hypothèse que ces trois catégories n'en font qu'une. La zone géographique peut alors se découper en trois grandes zones, et pas en six. On notera que cela correspond à ce que propose un arbre de régression
> library(tree)
> arbre=tree(nbre~zone+offset(log(exposition)),
+ data=base,split="gini")
> plot(arbre)
> text(arbre)

Monday, October 10 2011

ACT2040, régression binomiale et arbres

Mardi, avant de parler de la régression poissonienne, on va revenir un peu sur les modèles binomiaux, et présenter les arbres de régression. Pour la théorie, je peux renvoyer vers des notes de cours sur internet (ici, , ou encore) mais je présenterais les grandes idées au tableau. Pour le code, c'est assez facile
> sinistre=read.table("http://freakonometrics.free.fr/sinistreACT2040.txt",
+ header=TRUE,sep=";")
> sinistres=sinistre[sinistre$garantie=="1RC",]
> contrat=read.table("http://freakonometrics.free.fr/contractACT2040.txt",
+ header=TRUE,sep=";")
> T=table(sinistres$nocontrat)
> T1=as.numeric(names(T))
> T2=as.numeric(T)
> nombre1 = data.frame(nocontrat=T1,nbre=T2)
> I = contrat$nocontrat%in%T1
> T1= contrat$nocontrat[I==FALSE]
> nombre2 = data.frame(nocontrat=T1,nbre=0)
> nombre=rbind(nombre1,nombre2)
> base = merge(contrat,nombre)
> Y = base$nbre>0
> X1 = base$ageconducteur
> library(tree)
> arbre=tree(Y~X1,split="gini")
> plot(arbre)
> text(arbre,cex=.8)

Pour élaguer, il y a plusieurs méthodes, mais le plus simple est de demander de constituer des classes avec suffisamment de monde dedans,
> arbre=tree(Y~X1,split="gini", mincut = 5000)
> plot(arbre)
> text(arbre,cex=.8)

On peut bien sûr rajouter plusieurs variables (qualitatives comme quantitatives),
> age=base$ageconducteur
> car=base$agevehicule
> region=base$zone
> arbre=tree(Y~age+car+region,split="gini", mincut = 2600)
> plot(arbre)
> text(arbre,cex=.8)

Pour mieux comprendre la mise en œuvre pratique, et l'algorithme itératif qui se cache derrière, on peut utiliser le code suivant, calculant la distance du chi-deux, l'entropie, ou le critère de Gini
> u=sort(unique(base$ageconducteur))
> base$Y = base$nbre>0
> gini=entropie=chideux=rep(NA,length(u))
> for(i in 2:(length(u))){
+ I=base$ageconducteur<(u[i]-.5)
+ ft1=sum(base$Y[I==TRUE])/nrow(base)
+ ff1=sum(base$Y[I==FALSE])/nrow(base)
+ ft0=sum(1-base$Y[I==TRUE])/nrow(base)
+ ff0=sum(1-base$Y[I==FALSE])/nrow(base)
+ M=matrix(c(ft0,ff0,ft1,ff1),2,2)
+ ft=ft0+ft1
+ f0=ft0+ff0
+ Mind=matrix(c(ft*f0,f0*(1-ft),(1-f0)*ft,(1-f0)*(1-ft)),2,2)
+ Q=sum(nrow(B)*(M-Mind)^2/Mind)
+ entropie[i] = -((ft1+ft0)*(ft1/(ft1+ft0)*log(ft1/(ft1+ft0))+
+ ft0/(ft1+ft0)*log(ft0/(ft1+ft0))) +
+ (ff1+ff0)*(ff1/(ff1+ff0)*log(ff1/(ff1+ff0))+
+ ff0/(ff1+ff0)*log(ff0/(ff1+ff0)))
+ )
+
+ gini[i] = -((ft1+ft0)*(ft1/(ft1+ft0)*(1-ft1/(ft1+ft0))+
+ ft0/(ft1+ft0)*(1-ft0/(ft1+ft0))) +
+ (ff1+ff0)*(ff1/(ff1+ff0)*(1-ff1/(ff1+ff0))+
+ ff0/(ff1+ff0)*(1-ff0/(ff1+ff0))))
+
+ chideux[i] = Q
+ }
> plot(u-.5,entropie,type="b",pch=19,col="blue",
+ ylab="Entropie ou déviance",xlab="Age du conducteur")
> n=which.min(entropie)
> points(u[n]-.5,entropie[n],pch=19,col="red",cex=1.5)
Pour rappel, les trois critères sont données par les relations suivantes. Pour le critère du chi-deux,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-01.png
où, classiquement
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-02.png
pour le découpage en deux classes, puis
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-05.png
pour le découpage en trois classes, etc. Pour l'entropie,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-03.png
avec deux classes, ou, si on a trois classes,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-06.png
Enfin le critère de Gini,
L'image “http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-04.png” ne peut être affichée car elle contient des erreurs.
avec deux classes, ou avec trois,

http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-07.png

Tuesday, April 6 2010

Découper les arbres

Suite à une question sur l'utilisation des arbres en tarification automobile (ici), je vais revenir sur la construction des classes, de manière "plus pratique".

Commençons par l'utilisation du critère du chi-deux,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-01.png
où, classiquement
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-02.png
On va donc couper la variable âge en deux classes, disons [18,a] (notée A) et [a+1,90] (notée B). On va alors attribuer à a toutes les valeurs possibles et imaginables, entre 18 et 90 (le minimum et le maximum des données observées). On obtient alors les valeurs suivantes

Autrement dit, le découpage qui permet d'avoir des classes les moins indépendantes possibles serait [18-27] et [28-90]. Une fois constituée cette séparation, on va continuer. On va alors chercher à couper un des deux groupes en deux. Autrement dit, on aura trois classes,
  • [18,b] (notée A), [b+1,27] (notée B) et [28,90] (notée C)
  • [18,27] (notée A), [28,b] (notée B) et [b+1,90] (notée C)
On calcule alors la distance du chi-deux entre les deux variables,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-05.png
et on a les valeurs suivantes,

Autrement dit, cette fois on nous recommande le découpage [18-27], [28-75] et [76-90]. Mais on peut essayer de changer de critère, par exemple on peut calculer l'entropie, avec pour commencer un découpage en deux classes,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-03.png
soit numériquement,

ou avec trois classes,
http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-06.png

Enfin, on peut aussi utiliser le critère de Gini, là aussi pour constituer deux classes,
L'image “http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-04.png” ne peut être affichée car elle contient des erreurs.

ou pour séparer en trois classes,

http://perso.univ-rennes1.fr/arthur.charpentier/latex/arbre-comp-07.png

soit, numériquement,

Bref, sur cet exemple, quelle que soit la méthode de découpage retenu, on arrive au même découpage. Ah oui, le code sous R est assez simple (mais loin d'être optimal),

> B=read.table("D:\\base-continuite-classe-logistique.txt")
> u=sort(unique(B$age))
> gini=entropie=chideux=rep(NA,length(u))
> for(i in 2:(length(u))){
+ I=B$age<(u[i]-.5)
+ ft1=sum(B$Y[I==TRUE])/nrow(B)
+ ff1=sum(B$Y[I==FALSE])/nrow(B)
+ ft0=sum(1-B$Y[I==TRUE])/nrow(B)
+ ff0=sum(1-B$Y[I==FALSE])/nrow(B)
+ M=matrix(c(ft0,ff0,ft1,ff1),2,2)
+ ft=ft0+ft1
+ f0=ft0+ff0
+ Mind=matrix(c(ft*f0,f0*(1-ft),(1-f0)*ft,(1-f0)*(1-ft)),2,2)
+ Q=sum(nrow(B)*(M-Mind)^2/Mind)
+  entropie[i] = -((ft1+ft0)*(ft1/(ft1+ft0)*log(ft1/(ft1+ft0))+
+           ft0/(ft1+ft0)*log(ft0/(ft1+ft0))) +
+                  (ff1+ff0)*(ff1/(ff1+ff0)*log(ff1/(ff1+ff0))+
+           ff0/(ff1+ff0)*log(ff0/(ff1+ff0)))
+ )
+
+  gini[i] = -((ft1+ft0)*(ft1/(ft1+ft0)*(1-ft1/(ft1+ft0))+
+           ft0/(ft1+ft0)*(1-ft0/(ft1+ft0))) +
+                  (ff1+ff0)*(ff1/(ff1+ff0)*(1-ff1/(ff1+ff0))+
+           ff0/(ff1+ff0)*(1-ff0/(ff1+ff0))))
+
+ chideux[i] = Q
+ }
> plot(u-.5,entropie,type="b",pch=19,col="blue",
+ ylab="Entropie ou déviance",xlab="Age du conducteur")
> n=which.min(entropie)
> points(u[n]-.5,entropie[n],pch=19,col="red",cex=1.5)