# Classification on the German Credit Database

In our data science course, this morning, we’ve use random forrest to improve prediction on the German Credit Dataset. The dataset is

```> url="http://freakonometrics.free.fr/german_credit.csv"

Almost all variables are treated a numeric, but actually, most of them are factors,

```> str(credit)
'data.frame':	1000 obs. of  21 variables:
\$ Creditability   : int  1 1 1 1 1 1 1 1 1 1 ...
\$ Account.Balance : int  1 1 2 1 1 1 1 1 4 2 ...
\$ Duration        : int  18 9 12 12 12 10 8  ...
\$ Purpose         : int  2 0 9 0 0 0 0 0 3 3 ...```

(etc). Let us convert categorical variables as factors,

```> F=c(1,2,4,5,7,8,9,10,11,12,13,15,16,17,18,19,20)
> for(i in F) credit[,i]=as.factor(credit[,i])```

Let us now create our training/calibration and validation/testing datasets, with proportion 1/3-2/3

```> i_test=sample(1:nrow(credit),size=333)
> i_calibration=(1:nrow(credit))[-i_test]```

The first model we can fit is a logistic regression, on selected covariates

```> LogisticModel <- glm(Creditability ~ Account.Balance + Payment.Status.of.Previous.Credit + Purpose +
Length.of.current.employment +
Sex...Marital.Status, family=binomial,
data = credit[i_calibration,])```

Based on that model, it is possible to draw the ROC curve, and to compute the AUC (on ne validation dataset)

```> fitLog <- predict(LogisticModel,type="response",
+                   newdata=credit[i_test,])
> library(ROCR)
> pred = prediction( fitLog, credit\$Creditability[i_test])
> perf <- performance(pred, "tpr", "fpr")
> plot(perf)
> AUCLog1=performance(pred, measure = "auc")@y.values[[1]]
> cat("AUC: ",AUCLog1,"\n")
AUC:  0.7340997```

An alternative is to consider a logistic regression on all explanatory variables

```> LogisticModel <- glm(Creditability ~ .,
+  family=binomial,
+  data = credit[i_calibration,])```

We might overfit, here, and we should observe that on the ROC curve

```> fitLog <- predict(LogisticModel,type="response",
+                   newdata=credit[i_test,])
> pred = prediction( fitLog, credit\$Creditability[i_test])
> perf <- performance(pred, "tpr", "fpr")
> plot(perf)
> AUCLog2=performance(pred, measure = "auc")@y.values[[1]]
> cat("AUC: ",AUCLog2,"\n")
AUC:  0.7609792```

There is a slight improvement here,  compared with the previous model, where only five explanatory variables were considered.

Consider now some regression tree (on all covariates)

```> library(rpart)
> ArbreModel <- rpart(Creditability ~ .,
+  data = credit[i_calibration,])```

We can visualize the tree using

```> library(rpart.plot)
> prp(ArbreModel,type=2,extra=1)```

The ROC curve for that model is

```> fitArbre <- predict(ArbreModel,
+                     newdata=credit[i_test,],
+                     type="prob")[,2]
> pred = prediction( fitArbre, credit\$Creditability[i_test])
> perf <- performance(pred, "tpr", "fpr")
> plot(perf)
> AUCArbre=performance(pred, measure = "auc")@y.values[[1]]
> cat("AUC: ",AUCArbre,"\n")
AUC:  0.7100323```

As expected, a single has a lower performance, compared with a logistic regression. And a natural idea is to grow several trees using some boostrap procedure, and then to agregate those predictions.

```> library(randomForest)
> RF <- randomForest(Creditability ~ .,
+ data = credit[i_calibration,])
> fitForet <- predict(RF,
+                     newdata=credit[i_test,],
+                     type="prob")[,2]
> pred = prediction( fitForet, credit\$Creditability[i_test])
> perf <- performance(pred, "tpr", "fpr")
> plot(perf)
> AUCRF=performance(pred, measure = "auc")@y.values[[1]]
> cat("AUC: ",AUCRF,"\n")
AUC:  0.7682367```

Here this model is (slightly) better than the logistic regression. Actually, if we create many training/validation samples, and compare the AUC, we can observe that – on average – random forests perform better than logistic regressions,

```> AUC=function(i){
+   set.seed(i)
+   i_test=sample(1:nrow(credit),size=333)
+   i_calibration=(1:nrow(credit))[-i_test]
+   LogisticModel <- glm(Creditability ~ .,
+    family=binomial,
+    data = credit[i_calibration,])
+   summary(LogisticModel)
+   fitLog <- predict(LogisticModel,type="response",
+                     newdata=credit[i_test,])
+   library(ROCR)
+   pred = prediction( fitLog, credit\$Creditability[i_test])
+   AUCLog2=performance(pred, measure = "auc")@y.values[[1]]
+   RF <- randomForest(Creditability ~ .,
+   data = credit[i_calibration,])
+   fitForet <- predict(RF,
+                       newdata=credit[i_test,],
+                       type="prob")[,2]
+   pred = prediction( fitForet, credit\$Creditability[i_test])
+   AUCRF=performance(pred, measure = "auc")@y.values[[1]]
+   return(c(AUCLog2,AUCRF))
+ }
> A=Vectorize(AUC)(1:200)
> plot(t(A))```

# Base de Données de Classification

Vendredi matin, nous aurons un TP sur les méthodes de classification. Nous travaillerons sur la base de données suivante,

```> source(
"http://freakonometrics.free.fr/ds_credit.R")```

La description complète des variables (et des modalités) est en ligne sur archive.ics.uci.edu/ml/

# Correlations, dimension, and risk measure

Yesterday, while I was attending the IFM2 conference, at HEC Montreal, I heard a nice talk about credit risk, and a comparison between contagion (or at least default correlation), for corporate and retail companies (in the US). And it was mentioned that default correlation was much lower for retail companies than it could be for corporate risk. In a discussion that followed those slides, it was mentioned that banks in the US should actually have been working more with those small firms, since contagion risk was much lower.

A problem here is that the link between correlation, risk and dimension is rather complicated:

• corporate means a small number of firms, high correlation (and possible large individual losses)
• retail means a large number of firms (even perhaps extremely large), lower correlation (and small individual losses)

A simple model for default models is based on the assumption that we deal with an exchangeable portfolio (as in a previous post). With the following code, given an (individual) default probability, a default correlation, and a number of firms, it is possible to calculate the probability to have more than a given number of defaults.

``` proba=function(s,a,m,n){
b=a/m-a
choose(n,s)*integrate(function(t){t^s*(1-t)^(n-s)*
dbeta(t,a,b)},lower=0,upper=1,subdivisions=1000,
stop.on.error =  FALSE)\$value}

CDF=function(x=10,r=.4,m=.1,n=50){
a=m*(1-r)/r ;
V=rep(NA,n+1)
for(i in 0:n){
V[i+1]=proba(i,a,m,n)}
V=V/sum(V);
return(sum(V[1:(x+1)])) }```

It is possible to calculate, for a large range of correlations, the probability to have – at least – 20% of default in the portfolio (in order to compare things that are comparable).

```R=seq(.01,.99,by=.01)
VQ=matrix(NA,length(A),2)
for(i in 1:length(A)){
VQ[i,1]=1-CDF(r=A[i],x=4,n=20);
VQ[i,2]=1-CDF(r=A[i],x=200,n=1000)}```

With 20 firms (corporate) we want to have at least 4 defaults, while with 1000 firms (retail) there should be 200 defaults. As mentioned in the previous post, the relationship between correlation and quantiles of sums is not simple. Hence, it might not be monotone. The dotted line is the probability to have at least 4 defaults when default correlation is 50% (around 10%). The plain line is the probability to have at least 200 defaults, as a function of the correlation,

```plot(A,1-VQ[,2],type="l",col="red",ylim=c(0,.22))
abline(h=1-VQ[50,1],lty=2,col="red")```

In that case, with only a correlation of 10% among retail firms, the probability of having 20% defaults is the same as the same probability for corporate, but with 50% correlation… One should remember that in portfolio analysis, the links between correlation, dimension and risk measure is a sensitive issue…

# Exchangeability, credit risk and risk measures

Exchangeability is an extremely concept, since (most of the time) analytical expressions can be derived. But it can also be used to observe some unexpected behaviors, that we will discuss later on with a more general setting. For instance, in a old post, I discussed connexions between correlation and risk measures (using simulations to illustrate, but in the context of exchangeable risk, calculations can be performed more accurately). Consider again the standard credit risk problem, where the quantity of interest is the number of defaults in a portfolio. Consider an homogeneous portfolio of exchangeable risk. The quantity of interest is here

or perhaps the quantile function of the sum (since the Value-at-Risk is the standard risk measure). We have seen yesterday that – given the latent factor – (either the company defaults, or not), so that

i.e. we can derive the (unconditional) distribution of the sum

so that the probability function of the sum is, assuming that

Thus, the following code can be used to calculate the quantile function

```> proba=function(s,a,m,n){
+ b=a/m-a
+ choose(n,s)*integrate(function(t){t^s*(1-t)^(n-s)*
+ dbeta(t,a,b)},lower=0,upper=1,subdivisions=1000,
+ stop.on.error =  FALSE)\$value
+ }
> QUANTILE=function(p=.99,a=2,m=.1,n=500){
+ V=rep(NA,n+1)
+ for(i in 0:n){
+ V[i+1]=proba(i,a,m,n)}
+ V=V/sum(V)
+ return(min(which(cumsum(V)>p))) }```

Now observe that since variates are exchangeable, it is possible to calculate explicitly correlations of defaults. Here

i.e.

Thus, the correlation between two default indicators is then

Under the assumption that the latent factor is beta distributed

we get

Thus, as a function of the parameter of the beta distribution (we consider beta distributions with the same mean, i.e. the same margin distributions, so we have only one parameter left, with is simply the correlation of default indicators), it is possible to plot the quantile function,

```> PICTURE=function(P){
+ A=seq(.01,2,by=.01)
+ VQ=matrix(NA,length(A),5)
+ for(i in 1:length(A)){
+ VQ[i,1]=QUANTILE(a=A[i],p=.9,m=P)
+ VQ[i,2]=QUANTILE(a=A[i],p=.95,m=P)
+ VQ[i,3]=QUANTILE(a=A[i],p=.975,m=P)
+ VQ[i,4]=QUANTILE(a=A[i],p=.99,m=P)
+ VQ[i,5]=QUANTILE(a=A[i],p=.995,m=P)
+ }
+ plot(A,VQ[,5],type="s",col="red",ylim=
+ c(0,max(VQ)),xlab="",ylab="")
+ lines(A,VQ[,4],type="s",col="blue")
+ lines(A,VQ[,3],type="s",col="black")
+ lines(A,VQ[,2],type="s",col="blue",lty=2)
+ lines(A,VQ[,1],type="s",col="red",lty=2)
+ lines(A,rep(500*P,length(A)),col="grey")
+ legend(3,max(VQ),c("quantile 99.5%","quantile 99%",
+ "quantile 97.5%","quantile 95%","quantile 90%","mean"),
+ col=c("red","blue","black",
+"blue","red","grey"),
+ lty=c(1,1,1,2,2,1),border=n)
+}```

e.g. with a (marginal) default probability of 15%,

`> PICTURE(.15)`

On this graph, we observe that the stronger the correlation (the more on the left), the higher the quantile… Note that the same graph can be plotted with on the X-axis the correlation,

Which is quite intuitive, somehow. But if the marginal probability of default decreases, increasing the correlation might decrease the risk (i.e. the quantile function),

`> PICTURE(.05)`

(with the modified code to visualize the quantile as a function of the underlying default correlation) or even worse,

`> PICTURE(.0075)`

And it because all the more counterintuitive that the default probability decreases ! So in the case of a portfolio of non-very risky bond issuers (with high ratings), assuming a very strong correlation will lower risk based capital !

# de Finetti’s theorem and exchangeability

This week, we will start to work on multivariate models, and non-independence. The first idea to discuss non-independence will be to use the concept ofexchangeability. A sequence of random variable  is said to be exchangeable if for all

for any permutation  of . A standard example is the case where, with

and

Since , a necessary condition is that

i.e.

Since this inequality should hold for all  it comes that necessarily .
de Finetti (1931): Let  be a sequence of random variables with values in  is exchangeable if and only if there exists a distribution function  on  such that

where . Note that  is the distribution function of random variable

A nice proof of that result can be found in Heath & Sudderth (1995) – see alsoSchervish (1995)Chow & Teicher (1997) or Durrett (2010) and also probably in several bayesian books because that result has a strong interpretation in bayesian inference (as far as I understood, see e.g. Jaynes (1982)).
From the exchangeability condition, for any permutation  of ,

that can be inverted in

The idea is then to extend the size of the vector , i.e. for all , define

so that, if we condition on ,

but since given the sum of components of , all possible rearrangements of the ones among the  elements are equally likely, we can write

The first idea is to work on the blue term, and to invocate a theorem of approximation of the hypergeometric distribution  to a binomial distribution , when  becomes large. Then

Let  and let  denote the cumulative distribution function of .

The idea is then to write the sum as an integral, with respect to that distribution,

The theorem is then obtained since , i.e.

In the case of non-binary sequences, there is an extension of the previous result,
Hewitt & Savage (1955): Let  be a sequence of random variables with values in .   is exchangeable if and only if there exists a measure  on  such that

where  is the measure associated to the empirical measure

and

For instance, in the Gaussian case mentioned earlier, if

then

where

i.e. conditionally on , the  are conditionally independent, with distribution . The proof can be found in Kingman (1978) and is based on martingale arguments.
Note that in the Gaussian case,  where  are i.i.d. random variables. To go further on exchangeability and related topics, see Aldous (1985)  (see also here).
This construction can be used in credit risk, to model defaults in an homogeneous portfolio, see e.g. Frey (2001),

Assuming a Beta distribution for the latent factor, we can derive the probability distribution of the sum

Since

if we assume that – given the latent factor –  (either the company defaults, or not),

i.e.

Thus, we can derive the (unconditional) distribution of the sum

i.e.

```> proba=function(s,a,m,n){
+ b=a/m-a
+ choose(n,s)*integrate(function(t){t^s*(1-t)^(n-s)*
+ dbeta(t,a,b)},lower=0,upper=1)\$value
+ }```

Based on that function, it is possible to plot the probability distribution over . In the upper corner is plotted the density of the Beta distribution.

```> a=2
> m=.2
+ n=10
+ V=rep(NA,n+1)
+ for(i in 0:n){
+ V[i+1]=proba(i,a,m,n)}
> barplot(V,names.arg=0:10)```

Those two theorems are extremely close,

De Finetti’s theorem: a random sequence  of  random variables is exchangeable if and only if ‘s are conditionnally independent, conditionnally on some random variable .

Hewitt-Savage’s theorem: a random sequence  is exchangeable if and only if ‘s are conditionnally independent, conditionnally on some sigma-algebra

Olshen (1974), proposed an interesting discussion about those theorems, see also in the Encyclopedia of Statistical Science,

The subtle difference between those two theorem is also discussed in Freedman (1965)

# Pauvres américains

Pendant nos vacances dans l’Aubrac avec des amis, Christian avait acheté Libé, et machinalement, j’ai entrepris de le survoler le lendemain matin (en sirotant mon café). Je suis tombé sur le paragraphe suivant qui a retenu mon attention pendant plusieurs jours…

L’auteur n’est pas n’importe qui, puisqu’il s’agit de Kenneth Rogoff (ici), grand spécialiste de l’économie américaine. Relisons la phrase afin de mieux comprendre ce qu’il dit: pour “25% des propriétaires immobiliers aux États-Unis” […] “la valeur de leur maison serait inférieure à leur crédit immobilier” 1. Je me permettrais de réécrire la phrase sous la forme suivante “pour un quart des propriétaires immobiliers américains n’ayant pas fini de rembourser leur crédit, la vente de leur maison ne leur permettrait pas de rembourser leur crédit” (c’est en tous les cas comme ça que je la comprends).
Cette petite phrase pourrait être intéressante, En tous les cas, elle semble importante dans l’argumentation visant à expliquer que les américains sont beaucoup trop endettés2. Mais 25%, en quoi est-ce vraiment exceptionnel ou incroyable voire inquiétant ? C’est quoi le pourcentage acceptable ou normal que l’on s’attendrait à avoir ?
N’ayant pas de statistiques sur le sujet, faisons des calculs.

• un peu de calcul d’actualisation de crédits

Car intuitivement, si un acheteur emprunte avec un faible apport, et sur une longue durée, son crédit va lui coûter cher, éventuellement plus cher que la maison. Au moins au début. Car avec le temps, la valeur du crédit diminue, alors que le prix de la maison, habituellement, augmente.
Considérons une maison de valeur 1 (a l’achat, histoire de simplifier, et de raisonner en pourcentage pour l’apport initial, par exemple). On dispose d’un capital initial (correspondant à l’apport), on contracte un crédit pour une durée , et on suppose que le taux pour le crédit est , et que le taux d’inflation est (la valeur de la maison peut augmenter dans le temps, mais aussi éventuellement baisser si la valeur de est négative). A la date , à son actif, le propriétaire possède la maison, d’une valeur (ce qu’il touche s’il revend la maison, si l’on oublie les frais associés); et au passif, il doit rembourser à la banque un montant , où est le montant des remboursement effectues tous les ans, i.e. solution de

Si on veut faire les choses proprement, il faudrait intégrer les frais de notaire (disons 7% de la valeur de la maison), ici notés ,

La valeur de la maison est inférieure à la valeur du crédit si

(les frais de notaires étant payés à l’achat comme on l’évoquait auparavant, mais aussi en cas de revente3). On peut faire le calcul facilement, sous R,

```valeur = function(t,T,a,r=.05,i=0,delta=.07){
k=(1-a+delta)/sum(1/(1+r)^(0:(T-1)))
s=(1+i)^t
v=(T-t)*k
return(c(s*(1-delta),v))}```

Par exemple, si est nul, on compare la valeur du crédit à la valeur de la maison au moment de l’achat. Pour quelqu’un ayant un apport de 25%, prenant un crédit avec 20 échéances (sur 20 ans) que l’on commence à rembourser le jour de la signature, la valeur de son crédit (sur une somme empruntée de 0.75) est de 1.2533, environ, si le taux de crédit est de l’ordre de 5%. C’est plus que la valeur (brute) de la maison (ici 1), voire beaucoup plus que ce que rapporterait la revente la maison, qui rapporterait 0.93, ce qui ne lui permet pas de rembourser le crédit….

```> valeur(0,20,.25,.05,0)
[1] 0.9300 1.2533```

Sur la même durée, vu après la 5ieme échéance (i.e. au bout de 25% des échéances) avec toujours un apport initial de 25%, la valeur du crédit restant à payer à la banque est de l’ordre de 0.94, c’est à dire à peu de choses près, la valeur de revente de la maison s’il n’y a pas d’inflation (ou de perte de valeur du bien immobilier).

```> valeur(5,20,.25,.05,0)
[1] 0.9300000 0.9399846```

Autrement dit, dans un monde avec une inflation nulle, avec des cohortes d’acheteurs constantes dans le temps, qui prendraient des crédits de 20 ans avec un apport de 25% de la valeur de la maison, 25% des emprunteurs ont, en moyenne, un crédit à rembourser supérieur à la valeur de revente de leur maison, comme le dit l’article. Cette proportion augment

• quand les taux d’emprunt augmentent
• quand la durée des emprunts augmente
• quand l’apport initial diminue

Mais on peut essayer de visualiser tout ça,

• visualisation des valeurs du crédit, et de la maison
```dessin=fonction(T=20,a=.333,r=.05,i=.02,delta=.07){
S=V=rep(NA,T)
for(j in 1:T){
S[j]=valeur(j-1,T,a,r,i)[1]
V[j]=valeur(j-1,T,a,r,i)[2]}
YL=range(S,V)
plot(1:T-.5,V,type="b",col="red",ylim=YL)
lines(1:T-.5,S,col="blue",type="b")
}```

Comme on le voit sur le dessin ci-dessous, la proportion des acheteurs dont la valeur du crédit excède la valeur de la maison est d’environ 20% (même avec un apport non négligeable, ici un tiers, et une inflation non nulle, ici 2%). On le voit sur le graphique ci-dessous, avec en bleu la valeur de la maison, et en rouge, la valeur du crédit,

On peut d’ailleurs faire varier les différents paramètres, comme le taux d’emprunt, avec une baisse (passant de 5% à 3%),

ou avec une hausse (passant de 5% à 7%),

On peut aussi faire varier l’apport initial (passant à 50%),

On peut enfin supprimer l’inflation, et supposer que le prix de la maison n’augmente pas vraiment…

Moralité? 25% semble effectivement important, trop important (pour une économie en bonne santé). Mais il ne faut pas se leurrer, car un pourcentage raisonnable (ou viable) semblerait être davantage aux alentours de 15% que de 0%.

• du crédit immobilier au crédit automobile

Et cela dit, 25% serait un pourcentage relativement faible si on regardait non pas les crédit immobiliers, mais les crédit automobiles. Car par rapport à la situation précédente, on est dans un cas où les taux sont élevés, et où la valeur du bien ne cesse de se dégrader. Par contre la durée est souvent plus courte. Une déflation de 10% n’est peut-être pas la meilleure modélisation qui soit de la perte de valeur du véhicule, mais en première approximation, ça devrait convenir,,,
Graphiquement, on a

Bref, dans le cas du crédit auto (où l’acheteur achèterait intégralement à crédit), dans une situation normale entre 70% et 80% des acheteurs de voiture à crédit sont dans une situation où la revente de leur voiture ne permettrait pas de rembourser leur crédit… Ne faudrait-il pas s’en inquiéter également ? Acheter à crédit un bien dont la valeur ne cesse de baisser, n’est-ce pas dangereux ?

1 au début de l’été, en discutant avec des couples d’amis, dont deux venaient d’avoir des postes de profs à l’autre bout de la France (et qui devaient revendre leur maison), j’ai été surpris de voir que quand ils parlaient de “ne pas perdre d’argent lors de la revente“, ils valorisaient la maison à partir du prix initial, auquel ils ajoutaient les frais de notaires, mais oubliaient le coût du crédit.
2 je me contenterais ici de discuter ce chiffre de 25%, et non pas de savoir si c’est grave que la revente de la maison ne permette pas de rembourser le crédit.
3 je préfère prendre en compte ces frais, car sinon, comme je l’avais déjà évoqué ici, l’achat d’une maison semble toujours une opération gagnante.