Classification Supervisée

Julien JACQUES

26/09/2018
PLS-DA
PLS-DA

I la méthode PLS a été vu dans le cours de régression : elle

consiste à créer parmi les variables explicatives X des
composantes PLS qui sont les plus corrélées possibles avec la
cible quantitative Y . Cette méthode est généralement notée
PLS1
I lorsqu’on dispose de plusieurs cibles Y , ou autrement dit
lorsque Y est multivariée (disons à q colonnes / dimensions),
la régression PLS2 est construire sur le même principe que
PLS1, mais en construisant des composantes PLS à la fois
dans X et dans Y (un peu comme en analyse canonique)
I la méthode PLS-DA est une méthode PLS2 où la variable
catégorielle Y est décomposée en C − 1 variable indicatrice.
I PLS-DA est à la fois descriptive et prédictive
I les VIP permettent d’évaluer l’importance des différentes
variables
PLS-DA sous R
Il existe plusieur librairies permettant de réaliser une PLS-DA, dont :

I DiscriMiner : fonction plsDA dans laquelle la validation croisée

est implémentée mais qui ne permet pas de prédire sur un
nouveau jeu de données
I mixOmics

Nous utiliserons la librairie mixOmics :

library(mixOmics)

et nous allons la tester sur les données iris :

X <- iris[,1:4]
Y <- iris[,5]
PLS-DA sous R
Réalisons une PLS-DA avec 2 composantes (nb par défaut) et
représentons les corrélations entre les composantes PLS et les
variables initiales

my_pls <- plsda(X,Y,ncomp=2)

plotVar(my_pls)

Correlation Circle Plots

1.0

0.5
Component 2

0.0
[Link]
[Link]

[Link]
−0.5

[Link]
−1.0

−1.0 −0.5 0.0 0.5 1.0

Component 1
PLS-DA sous R
On poeut également représenter les individus dans le plan des deux
premières composantes PLS

plotIndiv(my_pls,[Link]=T,ellipse=T,legend=T)

PlotIndiv
61

42

2 94
63
58
120 54
69
8182
88 99
107 70
90
91 80 9
1 114
73 93 14
60 39
147 135 8368
95 13
X−variate 2: 23% expl. var

109 2646
2
10284
143 56100 4
31
3510
124 122 74 72 43
112
134 97 65 30 48
3 Legend
127 55 36
115 77 7998
64 89
85 96
129
133 59
75 67 setosa
119 50
0 104 92 62
131
150
139
128
24 2512 7 versicolor
76 2729408
11778
123 108
105
148 3221 virginica
130 66 1841
1
113
146 138
53
87 71 44 3728 38
23
103 52 5
106 140
141142 51
136 111 57
116
144126 86 22
49
11
−1 121
101 125 47
45 20
145 149
137 19
6 17

15 33

−2 110 34

118132
16

−2 0 2
X−variate 1: 73% expl. var
PLS-DA sous R
Evaluons la qualité de prédiction en créant un échantillon d’apprentissage
et un échantillon test

samp <- sample(1:3, nrow(X), replace = TRUE)

test <- which(samp == 1)
train <- setdiff(1:nrow(X), test)
my_pls <- plsda(X[train,],Y[train],ncomp=2)
[Link] <- predict(my_pls,X[test,],dist = "[Link]")
Prediction <- [Link]$class$[Link][, 2]
print(table(Y=[Link](Y[test]),Prediction))

## Prediction
## Y setosa versicolor virginica
## setosa 14 0 0
## versicolor 0 12 8
## virginica 0 2 16

La qualité est assez mauvaise sur ces données connues comme faciles. . .
Un exemple en grande dimension

Nous allons utiliser le jeu de données [Link] qui contient 47

individus pour 1000 variables, avec un certain nombre de variables
manquantes.

library(mixOmics)
data([Link])
X <- [Link]$[Link]
Y <- [Link]$sample$treatment
Un exemple en grande dimension
my_pls <- plsda(X,Y,ncomp=2)
plotVar(my_pls)
Correlation Circle Plots

1.0

0.5 1582
1194 1491
1416
1370 1479
1603
1372 783 1541
1637 1707
14761639 1008
1660
9041606 1485
1607
1583
1413 1213
1195 955965 419
882 1216
1141
1578
1427
1656
1402
1592
1153
1193
1189
1664
16651344
1498
1212
1128
37
1167
1018
1597
1513 1518
1586
1595
1147
1596
1746
1547
13761684
1280
1661
1166
995 753548
1390
1164 1503
621 1570 1478 689685
1134 1682
1698 1191
1646961
15643151186
1612 1414
1574
1662
13601403
1671 1361
1703
1313
524 1347
277 1105
1009
1446
1219
1422
1562
878
1215
883 276
1410
1146
1152
1429 1634
1648
1659
1546 1187
908
1371
1590 1568
1204 1663
9161536
1515
22
1723 127
1467
4011190
623530
1508 758
1163 762682
884
14171580
1587 1556
1557
78414081473 1205
1673
1530
1560
942 1635
16541679
964
1632
1234
1111
1677
1421 318
1437309
1689
1159
744369631291
1102 1048
1180958 1331
1296 1339 495
690
881
877121811601409
1575 1436
14451000
8101431
311
1666
17251206
1449
313 1425
11711294 447
1499
484 482 1540
1507 1377
9895271708 170
1576
910 1201
859 1460
915
1064
1448
10901522
1116
7961223
1474
1511
1149 976 387
14381650 1047
545 1031
1338 1044
1256
9671539
1687
1051 1057 286 946
622
1538 298 115
867 1555 1627 777 396
781 1045 1667
1457
1017
1609 385
957
1059395
475 968
408
456 272
Component 2

1424919
797
8961117
1695
1404
1129 787766
1678
476
1531 1699
1617
894
1668 1196
1652
1585
786 1110
1753
1447
778 937
1034936
1197
1455
1721 1702
1636
1065
544
10321066
1122969
366
390 94913
372333 236
451
1012417
592 248
228 1332 4 692
860 1551
1692 806
864
1137
875 1524
914 1589
1669
1200
16301459
1115
1391
543
1651 1362
1552
1028
1183 1629
1509
546
1733
16281261
1615
1690
1613 971
950
1333
1320 26 4481722
1278
1466 92
625
303
9661068
422
16
91 51 1302
558
561 761432 700
840 917 830
1029
1653 11501624
1584 485
1356
1283
1611
900
1144 247
1053
1622
15011537
740
1011 552
1732
4901510 1085
523 594
306
1747 1260
606
1737497593
403
1037 1329
1003 645
415
138426
87 439
302 3 653 48
823
879
899
8271138 1074
812 862
844
1226 1355
1091
409
979
1514
11741099147
1683 1442
274
1480 1266
913
1354
792 332
6301238
1439
814413 319 1735
760
619 598
1254
1258
466
142
246 128 172
430 166
0.0
795868
871 818885
850 898
1113
480
869 1227
1181
1456
1156909 1088
1265
1343
1384
1341
1177
1103
1173 496
1631 393912388
5291386
934
1267
1272
935 1350
125
220
1052
1249 972
1298
513
741
479 743
308
973574
382 423
649
1038
1259161
223
239
13401248
411 1324
944626
993 444
103506 17
735
720
8631453 857 1373
1335
1114
831 1728
1239
144 457556
1121 1035
262631 138958
512
421
553
1461
493 771
539
242 267
455
8
528
1740
414
1713 251
1107
587
57
1268 663
620
173 736
870855 824 1021
801
822 488 1096
1292 588 1375
383 1704
1069 491
1316
218
1488 532555
1688
305 1263
586 216
1124
1016 1072
1257
590
565 148
1369280 27
85704596100 190 187729
819780 1093 534
1157 499
7911407
764 5801242
585 554
575
537
1022
767 1349
241
492 1005
1040 947
776
158
1731
1451
607
642
1749 616 1182
1058
648
1523 581
1071
560 316
400
1247
520 252
986
738
701
614671 726
136
77 708
97
1396
678 604
186
675
845 893 1502
460 35
240 117218
1041
1084
1024
1317 551
354 1002
1322
371 1398255
757 39445
1311 96
118
557 273 661
68064 196
697 19150189
8658031623
1136 816
769467
1033
921
570 1126348
1487
1543
1406
1092 112 1545
1001
1358
1097281
765
1083
1100
1710
1544
928
1026
599
156521249
983
73
326
462
1364
134
515
610
1399
1279 624
747
550
1015
617
436
31
519
1495
154
662 10
1049
359
265
221 168
394
245
1043
668
469
696
328 721
733
169
659
669
367
698
62
364178
681
679
440
81
502
656290
670
199
175433
108
442
703
838 600
811
1170 1463
1112 895 1401
1741 1368 990
1521
1123
176 483
1305
271
1400
1162 392997
1482
254 358
1709
737
12 695
52 179
380
637 194
443244
666
564 1326 770 1712
1080 813
59266362
1717
225
435
1025 66
61 157
78 416
1178
1179 45591
500
1246
13281285
114636
105
1275
1470
9384
15
407
450 289
63
425
102 503
676375
300
848 836821
852886 1380
981 55 576
9111750
577
634
569
458
1104 130
1276 65
3631734
563
589
140
725 1284
82
19 44 229
139 672 202184337374
68 1287 1023 718 1027
509
56107340
41 72
474
705
361
206
42
133
330
177
638 151
113
717 291
706
477
232
510
342
203
719
352
345
1620 541 1366 471 250 210
355
1367 601
212 231
731
341 120
230
89
389 109 71637327080
301 724
205
79 1304 74 71360
1471 90
346 370
595 1327 732
209 269 710
−0.5 110
111 381
365 707

−1.0
Un exemple en grande dimension

On peut calculer les VIP

VIP=vip(my_pls)
rownames(VIP)=[Link]$genes$name
print(head(sort(VIP[,1],decreasing = T)))

## CTGF GEM CDK5R1 FOS ATF3 DPYSL3

## 4.032304 3.990062 3.669865 3.507805 3.292696 3.241185
Un exemple en grande dimension

plotIndiv(my_pls,[Link]=T,ellipse=T,legend=T)

PlotIndiv

59

33
10 56

60
62 73
61
53 29
79 24 36
82 50
X−variate 2: 5% expl. var

55 28
72 25 42

65 66 83
80
Legend
0 47 31 40
78 41
81 27 23 45 AF
64 BE

58 51 84 26
5232
54
30
37
46
−10 49 44

48 39

−20 −10 0
X−variate 1: 11% expl. var
10 20
Les classes ont l’air
super bien séparées. . .
Un exemple en grande dimension
Vu la taille d’échantillon, nous implémentons une validation croisée
LOO pour évaluer la qualité de prédiction
bonclass=0
pred=NULL
nbcomposantes=2
for (i in 1:nrow(X)){
my_pls <- plsda(X[-i,],Y[-i],ncomp=nbcomposantes)
tmp <- predict(my_pls,X[i,,drop=F],dist = "[Link]")
pred=c(pred,tmp$class$[Link][,nbcomposantes])
}
cat('Taux de bon classement : ',mean(pred==Y))

## Taux de bon classement : 0.5744681

Le taux de bon classement est faible par rapport à ce qu’on aurait pu

s’attendre en regardant la séparation des classes : mais attention cette
séparation des classes étaient sur les données d’apprentissage; La PLS-DA
a tendance ici a faire du sur-apprentissage
Un exemple en grande dimension
On peut tester un nombre de composantes plus important . . .

my_pls <- plsda(X,Y,ncomp=10)

plot(perf(my_pls,progressBar =F))

overall
BER
0.50

[Link]
[Link]
[Link]
0.45
Classification error rate

0.40
0.35

1 2 3 4 5 6 7 8 9 10

Component

Les différences entre les modèles ne sont pas flagrantes. . .