1. Importer les données

bank <- read.csv("https://r-stat-sc-donnees.github.io/bank-additional.csv",sep=";")

2. Construire et analyser l’arbre de classification

set.seed(5678)
perm <- sample(nrow(bank),3000)
bank.app <- bank[perm,]
bank.test <- bank[-perm,]

3. Choisir la taille de l’arbre

library(rpart)
bank.arbre1 <- rpart(y~.,data=bank.app,cp=0.02)
bank.arbre1

n= 3000 

node), split, n, loss, yval, (yprob)
      * denotes terminal node

  1) root 3000 342 no (0.88600000 0.11400000)  
    2) nr.employed>=5087.65 2634 177 no (0.93280182 0.06719818)  
      4) duration< 627.5 2428  70 no (0.97116969 0.02883031) *
      5) duration>=627.5 206  99 yes (0.48058252 0.51941748)  
       10) duration< 836.5 118  47 no (0.60169492 0.39830508) *
       11) duration>=836.5 88  28 yes (0.31818182 0.68181818) *
    3) nr.employed< 5087.65 366 165 no (0.54918033 0.45081967)  
      6) duration< 147 111  14 no (0.87387387 0.12612613) *
      7) duration>=147 255 104 yes (0.40784314 0.59215686)  
       14) pdays>=12.5 175  87 no (0.50285714 0.49714286)  
         28) contact=telephone 20   2 no (0.90000000 0.10000000) *
         29) contact=cellular 155  70 yes (0.45161290 0.54838710)  
           58) month=apr,aug,jul,may,nov,oct,sep 111  52 no (0.53153153 0.46846847)  
            116) duration< 339 70  25 no (0.64285714 0.35714286) *
            117) duration>=339 41  14 yes (0.34146341 0.65853659) *
           59) month=dec,jun,mar 44  11 yes (0.25000000 0.75000000) *
       15) pdays< 12.5 80  16 yes (0.20000000 0.80000000) *

library(rpart.plot)
rpart.plot(bank.arbre1,main="Représentation de l'arbre")

bank.arbre2 <- rpart(y~.,data=bank.app,maxcompete=2,maxsurrogate=1)
summary(bank.arbre2)

Call:
rpart(formula = y ~ ., data = bank.app, maxcompete = 2, maxsurrogate = 1)
  n= 3000 

          CP nsplit rel error    xerror       xstd
1 0.06871345      0 1.0000000 1.0000000 0.05089836
2 0.04678363      2 0.8625731 0.9561404 0.04990989
3 0.02339181      4 0.7690058 0.8421053 0.04717961
4 0.01169591      8 0.6637427 0.7777778 0.04552535
5 0.01023392     15 0.5730994 0.8070175 0.04628831
6 0.01000000     17 0.5526316 0.8040936 0.04621286

Variable importance
      duration    nr.employed      euribor3m          month            job 
            35             23             21              4              4 
         pdays      education       poutcome  cons.conf.idx        contact 
             2              2              2              2              2 
           age cons.price.idx        marital 
             1              1              1 

Node number 1: 3000 observations,    complexity param=0.06871345
  predicted class=no   expected loss=0.114  P(node) =1
    class counts:  2658   342
   probabilities: 0.886 0.114 
  left son=2 (2634 obs) right son=3 (366 obs)
  Primary splits:
      nr.employed < 5087.65 to the right, improve=94.58265, (0 missing)
      duration    < 606.5   to the left,  improve=89.55275, (0 missing)
      euribor3m   < 1.047   to the right, improve=79.61173, (0 missing)
  Surrogate splits:
      euribor3m < 1.1715  to the right, agree=0.984, adj=0.866, (0 split)

Node number 2: 2634 observations,    complexity param=0.04678363
  predicted class=no   expected loss=0.06719818  P(node) =0.878
    class counts:  2457   177
   probabilities: 0.933 0.067 
  left son=4 (2428 obs) right son=5 (206 obs)
  Primary splits:
      duration      < 627.5   to the left,  improve=91.403430, (0 missing)
      month         splits as  LLLLLRLLR-,  improve= 8.601910, (0 missing)
      cons.conf.idx < -48.55  to the right, improve= 7.550024, (0 missing)

Node number 3: 366 observations,    complexity param=0.06871345
  predicted class=no   expected loss=0.4508197  P(node) =0.122
    class counts:   201   165
   probabilities: 0.549 0.451 
  left son=6 (111 obs) right son=7 (255 obs)
  Primary splits:
      duration < 147     to the left,  improve=33.59241, (0 missing)
      pdays    < 11      to the right, improve=18.01599, (0 missing)
      poutcome splits as  LLR,         improve=16.07004, (0 missing)
  Surrogate splits:
      education splits as  RRRRLRRR, agree=0.699, adj=0.009, (0 split)

Node number 4: 2428 observations,    complexity param=0.01023392
  predicted class=no   expected loss=0.02883031  P(node) =0.8093333
    class counts:  2358    70
   probabilities: 0.971 0.029 
  left son=8 (2406 obs) right son=9 (22 obs)
  Primary splits:
      month         splits as  LLLLLRLLR-,  improve=9.857356, (0 missing)
      duration      < 454.5   to the left,  improve=8.616848, (0 missing)
      cons.conf.idx < -48.55  to the right, improve=8.051723, (0 missing)
  Surrogate splits:
      cons.conf.idx < -48.55  to the right, agree=0.998, adj=0.818, (0 split)

Node number 5: 206 observations,    complexity param=0.04678363
  predicted class=yes  expected loss=0.4805825  P(node) =0.06866667
    class counts:    99   107
   probabilities: 0.481 0.519 
  left son=10 (118 obs) right son=11 (88 obs)
  Primary splits:
      duration  < 836.5   to the left,   improve=8.103520, (0 missing)
      job       splits as  RRLRLLLLLRRR, improve=5.258691, (0 missing)
      euribor3m < 1.295   to the right,  improve=2.130374, (0 missing)
  Surrogate splits:
      job splits as  RLRLLLRLRLLL, agree=0.626, adj=0.125, (0 split)

Node number 6: 111 observations
  predicted class=no   expected loss=0.1261261  P(node) =0.037
    class counts:    97    14
   probabilities: 0.874 0.126 

Node number 7: 255 observations,    complexity param=0.02339181
  predicted class=yes  expected loss=0.4078431  P(node) =0.085
    class counts:   104   151
   probabilities: 0.408 0.592 
  left son=14 (175 obs) right son=15 (80 obs)
  Primary splits:
      pdays    < 12.5    to the right, improve=10.071480, (0 missing)
      poutcome splits as  LLR,         improve= 8.104308, (0 missing)
      contact  splits as  RL,          improve= 6.874714, (0 missing)
  Surrogate splits:
      poutcome splits as  LLR, agree=0.969, adj=0.9, (0 split)

Node number 8: 2406 observations
  predicted class=no   expected loss=0.02452203  P(node) =0.802
    class counts:  2347    59
   probabilities: 0.975 0.025 

Node number 9: 22 observations,    complexity param=0.01023392
  predicted class=no   expected loss=0.5  P(node) =0.007333333
    class counts:    11    11
   probabilities: 0.500 0.500 
  left son=18 (9 obs) right son=19 (13 obs)
  Primary splits:
      duration < 137.5   to the left,   improve=4.606838, (0 missing)
      age      < 33.5    to the right,  improve=1.571429, (0 missing)
      job      splits as  RL--RL-RRL--, improve=1.571429, (0 missing)
  Surrogate splits:
      age < 33.5    to the right, agree=0.682, adj=0.222, (0 split)

Node number 10: 118 observations,    complexity param=0.01169591
  predicted class=no   expected loss=0.3983051  P(node) =0.03933333
    class counts:    71    47
   probabilities: 0.602 0.398 
  left son=20 (24 obs) right son=21 (94 obs)
  Primary splits:
      job       splits as  RRLRRLRL-RLR, improve=4.500811, (0 missing)
      month     splits as  LR-LLLLR--,   improve=2.529116, (0 missing)
      education splits as  LLRR-LRL,     improve=2.278834, (0 missing)
  Surrogate splits:
      age < 54.5    to the right, agree=0.805, adj=0.042, (0 split)

Node number 11: 88 observations,    complexity param=0.01169591
  predicted class=yes  expected loss=0.3181818  P(node) =0.02933333
    class counts:    28    60
   probabilities: 0.318 0.682 
  left son=22 (38 obs) right son=23 (50 obs)
  Primary splits:
      job           splits as  RRLRLRLLLLRR, improve=4.421818, (0 missing)
      cons.conf.idx < -42.35  to the right,  improve=3.272727, (0 missing)
      campaign      < 3.5     to the right,  improve=2.550072, (0 missing)
  Surrogate splits:
      education splits as  RRRR-LRL, agree=0.625, adj=0.132, (0 split)

Node number 14: 175 observations,    complexity param=0.02339181
  predicted class=no   expected loss=0.4971429  P(node) =0.05833333
    class counts:    88    87
   probabilities: 0.503 0.497 
  left son=28 (20 obs) right son=29 (155 obs)
  Primary splits:
      contact        splits as  RL,          improve=7.122949, (0 missing)
      duration       < 390.5   to the left,  improve=6.054271, (0 missing)
      cons.price.idx < 92.681  to the left,  improve=5.282857, (0 missing)
  Surrogate splits:
      campaign < 6.5     to the right, agree=0.897, adj=0.1, (0 split)

Node number 15: 80 observations
  predicted class=yes  expected loss=0.2  P(node) =0.02666667
    class counts:    16    64
   probabilities: 0.200 0.800 

Node number 18: 9 observations
  predicted class=no   expected loss=0.1111111  P(node) =0.003
    class counts:     8     1
   probabilities: 0.889 0.111 

Node number 19: 13 observations
  predicted class=yes  expected loss=0.2307692  P(node) =0.004333333
    class counts:     3    10
   probabilities: 0.231 0.769 

Node number 20: 24 observations
  predicted class=no   expected loss=0.125  P(node) =0.008
    class counts:    21     3
   probabilities: 0.875 0.125 

Node number 21: 94 observations,    complexity param=0.01169591
  predicted class=no   expected loss=0.4680851  P(node) =0.03133333
    class counts:    50    44
   probabilities: 0.532 0.468 
  left son=42 (30 obs) right son=43 (64 obs)
  Primary splits:
      education splits as  LLRR-LRL,    improve=3.575177, (0 missing)
      month     splits as  LR-LLLLR--,  improve=3.440090, (0 missing)
      age       < 31.5    to the right, improve=2.875762, (0 missing)
  Surrogate splits:
      default splits as  RL-, agree=0.723, adj=0.133, (0 split)

Node number 22: 38 observations,    complexity param=0.01169591
  predicted class=no   expected loss=0.5  P(node) =0.01266667
    class counts:    19    19
   probabilities: 0.500 0.500 
  left son=44 (22 obs) right son=45 (16 obs)
  Primary splits:
      education     splits as  R-RL-RLL,    improve=3.454545, (0 missing)
      duration      < 1248.5  to the left,  improve=2.850000, (0 missing)
      cons.conf.idx < -42.35  to the right, improve=2.607843, (0 missing)
  Surrogate splits:
      job splits as  --R-L-LLRR--, agree=0.711, adj=0.312, (0 split)

Node number 23: 50 observations
  predicted class=yes  expected loss=0.18  P(node) =0.01666667
    class counts:     9    41
   probabilities: 0.180 0.820 

Node number 28: 20 observations
  predicted class=no   expected loss=0.1  P(node) =0.006666667
    class counts:    18     2
   probabilities: 0.900 0.100 

Node number 29: 155 observations,    complexity param=0.02339181
  predicted class=yes  expected loss=0.4516129  P(node) =0.05166667
    class counts:    70    85
   probabilities: 0.452 0.548 
  left son=58 (111 obs) right son=59 (44 obs)
  Primary splits:
      month          splits as  LLRLRRLLLL,  improve=4.994914, (0 missing)
      duration       < 228.5   to the left,  improve=4.185622, (0 missing)
      cons.price.idx < 92.681  to the left,  improve=2.837542, (0 missing)
  Surrogate splits:
      euribor3m < 1.162   to the left,  agree=0.877, adj=0.568, (0 split)

Node number 42: 30 observations
  predicted class=no   expected loss=0.2666667  P(node) =0.01
    class counts:    22     8
   probabilities: 0.733 0.267 

Node number 43: 64 observations,    complexity param=0.01169591
  predicted class=yes  expected loss=0.4375  P(node) =0.02133333
    class counts:    28    36
   probabilities: 0.437 0.562 
  left son=86 (32 obs) right son=87 (32 obs)
  Primary splits:
      job            splits as  LR-LL-L--R--, improve=3.125000, (0 missing)
      cons.price.idx < 93.681  to the right,  improve=3.125000, (0 missing)
      month          splits as  RR-LLLLR--,   improve=2.485604, (0 missing)
  Surrogate splits:
      education splits as  --RR--L-, agree=0.688, adj=0.375, (0 split)

Node number 44: 22 observations
  predicted class=no   expected loss=0.3181818  P(node) =0.007333333
    class counts:    15     7
   probabilities: 0.682 0.318 

Node number 45: 16 observations
  predicted class=yes  expected loss=0.25  P(node) =0.005333333
    class counts:     4    12
   probabilities: 0.250 0.750 

Node number 58: 111 observations,    complexity param=0.02339181
  predicted class=no   expected loss=0.4684685  P(node) =0.037
    class counts:    59    52
   probabilities: 0.532 0.468 
  left son=116 (70 obs) right son=117 (41 obs)
  Primary splits:
      duration < 339     to the left,   improve=4.697398, (0 missing)
      campaign < 1.5     to the left,   improve=1.859924, (0 missing)
      job      splits as  LLLRRLLRLLL-, improve=1.687881, (0 missing)
  Surrogate splits:
      job splits as  LLLLRLLRLLL-, agree=0.649, adj=0.049, (0 split)

Node number 59: 44 observations
  predicted class=yes  expected loss=0.25  P(node) =0.01466667
    class counts:    11    33
   probabilities: 0.250 0.750 

Node number 86: 32 observations,    complexity param=0.01169591
  predicted class=no   expected loss=0.40625  P(node) =0.01066667
    class counts:    19    13
   probabilities: 0.594 0.406 
  left son=172 (17 obs) right son=173 (15 obs)
  Primary splits:
      cons.price.idx < 93.681  to the right, improve=3.829657, (0 missing)
      month          splits as  RR-LR-LR--,  improve=2.604167, (0 missing)
      euribor3m      < 4.8555  to the right, improve=2.604167, (0 missing)
  Surrogate splits:
      month splits as  RR-LL-LR--, agree=0.844, adj=0.667, (0 split)

Node number 87: 32 observations
  predicted class=yes  expected loss=0.28125  P(node) =0.01066667
    class counts:     9    23
   probabilities: 0.281 0.719 

Node number 116: 70 observations
  predicted class=no   expected loss=0.3571429  P(node) =0.02333333
    class counts:    45    25
   probabilities: 0.643 0.357 

Node number 117: 41 observations,    complexity param=0.01169591
  predicted class=yes  expected loss=0.3414634  P(node) =0.01366667
    class counts:    14    27
   probabilities: 0.341 0.659 
  left son=234 (14 obs) right son=235 (27 obs)
  Primary splits:
      age         < 36      to the left,  improve=3.862305, (0 missing)
      day_of_week splits as  LRRRL,       improve=2.564024, (0 missing)
      marital     splits as  RRL-,        improve=2.051769, (0 missing)
  Surrogate splits:
      marital splits as  RRL-, agree=0.878, adj=0.643, (0 split)

Node number 172: 17 observations
  predicted class=no   expected loss=0.1764706  P(node) =0.005666667
    class counts:    14     3
   probabilities: 0.824 0.176 

Node number 173: 15 observations
  predicted class=yes  expected loss=0.3333333  P(node) =0.005
    class counts:     5    10
   probabilities: 0.333 0.667 

Node number 234: 14 observations
  predicted class=no   expected loss=0.3571429  P(node) =0.004666667
    class counts:     9     5
   probabilities: 0.643 0.357 

Node number 235: 27 observations
  predicted class=yes  expected loss=0.1851852  P(node) =0.009
    class counts:     5    22
   probabilities: 0.185 0.815 

printcp(bank.arbre1)

Classification tree:
rpart(formula = y ~ ., data = bank.app, cp = 0.02)

Variables actually used in tree construction:
[1] contact     duration    month       nr.employed pdays      

Root node error: 342/3000 = 0.114

n= 3000 

        CP nsplit rel error  xerror     xstd
1 0.068713      0   1.00000 1.00000 0.050898
2 0.046784      2   0.86257 0.97076 0.050243
3 0.023392      4   0.76901 0.86550 0.047760
4 0.020000      8   0.66374 0.85088 0.047398

set.seed(1234)
bank.arbre3 <- rpart(y~.,data=bank.app,cp=0.000001,minsplit=5)
printcp(bank.arbre3)

Classification tree:
rpart(formula = y ~ ., data = bank.app, cp = 1e-06, minsplit = 5)

Variables actually used in tree construction:
 [1] age            campaign       cons.price.idx contact        day_of_week   
 [6] duration       education      euribor3m      housing        job           
[11] loan           marital        month          nr.employed    pdays         

Root node error: 342/3000 = 0.114

n= 3000 

           CP nsplit rel error  xerror     xstd
1  0.06871345      0   1.00000 1.00000 0.050898
2  0.04678363      2   0.86257 0.96199 0.050044
3  0.02339181      4   0.76901 0.85673 0.047544
4  0.01169591      8   0.66374 0.83626 0.047033
5  0.01023392     16   0.56140 0.83626 0.047033
6  0.00877193     18   0.54094 0.80702 0.046288
7  0.00584795     19   0.53216 0.79825 0.046061
8  0.00487329     30   0.46784 0.80117 0.046137
9  0.00438596     33   0.45322 0.83918 0.047106
10 0.00389864     52   0.36842 0.84795 0.047326
11 0.00350877     71   0.28655 0.85965 0.047616
12 0.00292398     76   0.26901 0.88889 0.048329
13 0.00219298     95   0.21345 0.88889 0.048329
14 0.00194932     99   0.20468 0.91228 0.048888
15 0.00146199    102   0.19883 0.91520 0.048958
16 0.00097466    108   0.19006 0.93860 0.049505
17 0.00073099    114   0.18421 0.94152 0.049573
18 0.00058480    118   0.18129 0.94444 0.049641
19 0.00000100    123   0.17836 0.94444 0.049641

plotcp(bank.arbre3)

library(tidyverse)
cp_opt <- bank.arbre3$cptable %>% as.data.frame() %>%filter(xerror==min(xerror)) %>% select(CP) %>% max() %>% as.numeric()
bank.arbre.fin <- prune(bank.arbre3,cp=cp_opt)
rpart.plot(bank.arbre.fin,cex=0.5)

library(visNetwork)
visTree(bank.arbre.fin)

4. Faire de la prévision

predict(bank.arbre.fin,newdata=bank.test) %>% head(n=3)

         no        yes
5  0.975478 0.02452203
12 0.975478 0.02452203
13 0.975478 0.02452203

predict(bank.arbre.fin,newdata=bank.test,type="class") %>% head(n=3)

 5 12 13 
no no no 
Levels: no yes

5. Estimer les performances de l’arbre

prev.class <- data.frame(large=predict(bank.arbre3,newdata=bank.test,type="class"),fin=predict(bank.arbre.fin,newdata=bank.test,type="class"),obs=bank.test$y)
head(prev.class)

   large fin obs
5     no  no  no
12    no  no  no
13    no  no  no
14    no  no  no
15    no  no  no
21    no  no  no

prev.class %>% summarise_all(funs(err=mean(obs!=.))) %>% select(-obs_err) %>% round(3)

  large_err fin_err
1     0.118   0.095

score <- data.frame(large=predict(bank.arbre3,newdata=bank.test)[,2],fin=predict(bank.arbre.fin,newdata=bank.test)[,2],obs=bank.test$y)
library(plotROC)
df.roc <- score  %>% gather(key=methode,value=score,large,fin)
ggplot(df.roc)+aes(d=obs,m=score,color=methode)+geom_roc()+theme_classic()

df.roc %>% group_by(methode) %>% summarize(AUC=pROC::auc(obs,score)) 

# A tibble: 2 x 2
  methode   AUC
  <chr>   <dbl>
1 fin     0.867
2 large   0.766

6. Interpréter l’arbre

var.imp <- bank.arbre.fin$variable.importance
nom.var <- substr(names(var.imp),1,3)
nom.var[c(4,5)] <- c("co.c","co.p") #éviter les noms identiques
var.imp1 <- data.frame(var=nom.var,score=var.imp)
var.imp1$var <- factor(var.imp1$var,levels=nom.var)
ggplot(var.imp1)+aes(x=var,y=score)+geom_bar(stat="identity")+theme_classic()

bank.arbre.des <- rpart(y~.,data=bank.app,parms=list(loss=matrix(c(0,0.1,10,0),ncol=2)),cp=0.000001,minsplit=2)
cp_opt_des <- bank.arbre.des$cptable %>% as.data.frame() %>% filter(xerror==min(xerror)) %>% select(CP) %>% max() %>% as.numeric()
bank.arbre.fin.des <- prune(bank.arbre1,cp=cp_opt_des)
prev.class1 <- prev.class %>% mutate(des=predict(bank.arbre.fin.des,newdata=bank.test,type="class"))
prev.class1 %>% summarise_all(funs(err=mean(obs!=.))) %>% select(-obs_err) %>% round(3)

  large_err fin_err des_err
1     0.118   0.095   0.089

table(prev.class1$fin,prev.class1$obs)

     
       no yes
  no  961  57
  yes  49  52

table(prev.class1$des,prev.class1$obs)

     
       no yes
  no  966  56
  yes  44  53