On s’intéresse dans ce projet à la protéase du VIH, une enzyme qui possède un rôle majeur dans le cycle du virus du SIDA. Cette enzyme permet en effet le clivage de certaines protéines, ce qui a pour effet de libérer et de créer d’autres protéines néfastes à l’organisme et d’aider la propagation de la maladie.
Pour mieux comprendre comment fonctionne la protéase du VIH, on dispose d’une base de données contenant un ensemble d’octamères (i.e. une séquence de 8 acides aminés), dont certains ont été clivés par la protéase et d’autres non.
L’objectif de l’étude est de prédire, à partir de sa séquence d’acides aminés, si un octamère est clivé ou non par la protéase du VIH.
La base de données contient deux variables : la première variable Octamer
correspond à la séquence d’acides aminés composant l’octamère, et la deuxième variable Clived
vaut 1 si l’octamère a été clivé par la protéase, et -1 sinon.
library(readr)
data1625 <- read_csv("1625Data.txt") # On importe la table
head(data1625) # on affiche les 6 premières lignes
Octamer | Clived |
---|---|
SLNLRETN | 1 |
AECFRIFD | 1 |
HLVEALYL | 1 |
TQIMFETF | 1 |
AEELAEIF | 1 |
PFIFEEEP | 1 |
1
A partir de la séquence de 8 lettres, on construit 8 variables qualitatives contenant chacune une des lettres de la séquence.
X<-strsplit(as.character(data1625$Octamer),'',fixed=FALSE)
df <- data.frame(matrix(unlist(X), nrow=length(X), byrow=T))
colnames(df)<-c('v1','v2','v3','v4','v5','v6','v7','v8')
data1625<- cbind(data1625,df)[,-1]
head(data1625)
Clived | v1 | v2 | v3 | v4 | v5 | v6 | v7 | v8 |
---|---|---|---|---|---|---|---|---|
1 | S | L | N | L | R | E | T | N |
1 | A | E | C | F | R | I | F | D |
1 | H | L | V | E | A | L | Y | L |
1 | T | Q | I | M | F | E | T | F |
1 | A | E | E | L | A | E | I | F |
1 | P | F | I | F | E | E | E | P |
2
On recode la variable cible Clived
en un class factor
valant 0 ou 1.
'data.frame': 1625 obs. of 9 variables:
$ Clived: Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
$ v1 : Factor w/ 20 levels "A","C","D","E",..: 16 1 7 17 1 13 13 4 6 3 ...
$ v2 : Factor w/ 20 levels "A","C","D","E",..: 10 4 10 14 4 5 8 17 6 1 ...
$ v3 : Factor w/ 20 levels "A","C","D","E",..: 12 2 18 8 4 8 18 17 18 8 ...
$ v4 : Factor w/ 20 levels "A","C","D","E",..: 10 5 4 11 10 5 6 1 20 12 ...
$ v5 : Factor w/ 20 levels "A","C","D","E",..: 15 15 1 5 1 4 1 10 1 17 ...
$ v6 : Factor w/ 20 levels "A","C","D","E",..: 4 8 10 4 4 4 4 18 17 4 ...
$ v7 : Factor w/ 20 levels "A","C","D","E",..: 17 5 20 17 8 4 17 2 15 5 ...
$ v8 : Factor w/ 20 levels "A","C","D","E",..: 12 3 10 5 5 13 5 3 16 9 ...
3
La proportion d’octamères clivés :
library(highcharter)
highchart() %>%
hc_chart(type = "pie") %>%
hc_add_series(data1625$Clived, innerSize='80%') %>%
hc_plotOptions(
pie=list(
allowPointSelect= TRUE,
cursor= 'pointer',
dataLabels=list(
enabled= TRUE,
format= '<b>{point.name}</b>: {point.percentage:.1f} %'
)
)
)
4
On partionne la base en deux parties : entrainement \(75\)% et test \(25\)%, on utilise la fonction createDataPartition
du package caret
library(caret)
set.seed(123) # fixer la graine de l'aléa pour reproduire les memes résultats
trainIndex <- createDataPartition(data1625$Clived , p = .75, list = FALSE)
data.Train <- data1625[ trainIndex,]
data.Test <- data1625[-trainIndex,]
5
On construit le meilleur classifieur naif constant à partir de la base d’apprentissage ( ie attribue à toutes observation la même classe dominante)
le taux d’erreur sur la base de test correspond à la proportion de la classe 1
présente dans la base :
[1] 0.2296296
Comme les arbres CART sont à la base de la plupart des méthodes ensemblistes, on commence par étudier les performances obtenues sur un arbre individuel.
6
On construit une fonction qui prend en entrée un vecteur de prédictions ypred
(sous la forme 0
ou 1
) et un vecteur contenant les vraies classes yobs
, et qui calcule le taux d’erreur associé.
7
On construit un arbre de décision avec la fonction rpart
, en gardant les réglages par défaut.
library(rpart) # construction de l'arbre
library(sparkline) # dependance pour l'affichage de l'arbre
library(visNetwork) # affichage de l'arbre
set.seed(123)
model1 <- rpart(data.Train$Clived ~., data = data.Train)
visTree(model1,legend=FALSE,export=FALSE ) # on affiche l'arbre
On calcule le taux d’erreur sur la base de test.
preds <- predict(model1, newdata = data.Test, type = c("class")) # on calcul d'abord les prédictions de l'arbre
taux.erreur(preds,data.Test$Clived)
[1] 0.07407407
Le taux d’erreur est de 0.0741 !
8
On construit un arbre de décision profond, en modifiant les options maxdepth
, minbucket
et cp
.
set.seed(123)
options.profond =list(maxdepth=20, minbucket= 1, cp = 0 )
model.profond <- rpart(data.Train$Clived ~., data = data.Train, control =options.profond)
visTree(model.profond, legend=FALSE,export=FALSE)
On calcule ensuite le taux d’erreur sur la base de test.
preds.profond <- predict(model.profond, newdata = data.Test, type = c("class")) # on calcul d'abord les prédictions de l'arbre
taux.erreur(preds.profond ,data.Test$Clived)
[1] 0.08395062
Le taux d’erreur est de 0.084 !
9
On construit un arbre de décision de niveau 1 (avec seulement 1 noeud)
On calcule le taux d’erreur sur la base de test.
preds.stump <- predict(model.stump, newdata = data.Test, type = c("class")) # on calcul d'abord les prédictions de l'arbre
taux.erreur(preds.stump ,data.Test$Clived)
[1] 0.2222222
Le taux d’erreur est de 0.2222 !
9
res.arbres <- data.frame(
arbre = c("defaut", "profond", "stump"),
tx_err= c(round(taux.erreur(preds ,data.Test$Clived),4),
round(taux.erreur(preds.profond,data.Test$Clived),4),
round(taux.erreur(preds.stump ,data.Test$Clived),4)
)
)
hchart(res.arbres, "bar", hcaes(x = "arbre", y = "tx_err" ), colorByPoint= TRUE) %>%
hc_plotOptions(
bar= list(
dataLabels= list(
enabled= TRUE
)
)
) %>%
hc_add_theme(hc_theme_flatdark())
10
En constate que l’arbre de niveau 1 est le mois précis de tous, qui au final n’utilise qu’une seule variable (qui correspond à la quatrième lettre de la séquence d’acide aminé : v4) et donc n’apprend pas suffisament, puis l’arbre profond qui au contraire se colle aux donnée de la base d’apprentissage : d’où le risque de sur-apprentissage, finalement le meilleur modèle est l’arbre par défaut avec le paramètrage par défaut.
Le bagging permet de réduire la variance d’un classifieur par aggrégation. Il est donc particulièrement adapté lorsque le classifieur de base a un faible biais et une forte variance. Nous allons tester (vérifier) cette propriété.
Principe et algorithme : Soit \(Y\) une variable à expliquer quantitative ou qualitative, \(X^1, ... , X^p\) les variables explicatives et \(f(x)\) un modèle fonction de \(x = {x^1, . . . , x^p} ∈ \mathbb{R}^p\). On note \(n\) le nombre d’observations et \[z = \{(x_1, y_1), . . . ,(x_n, y_n)\}\] un échantillon de loi \(F\).
Considérant \(B\) échantillons indépendants notés \(\{z_b\}_{b=1,B}\), une prévision par agrégation de modèles est définie ci-dessous dans le cas où la variable à expliquer \(Y\) est :
Dans le premier cas, il s’agit d’une simple moyenne des résultats obtenus pour les modèles associés à chaque échantillon, dans le deuxième, un comité de modèles est constitué pour voter et élire la réponse la plus probable. Dans ce dernier cas, si le modèle retourne des probabilités associées à chaque modalité comme en régression logistique ou avec les arbres de décision, il est aussi simple de calculer des moyennes de ces probabilités.
Le principe est élémentaire, moyenner les prévisions de plusieurs modèles indépendants permet de réduire la variance et donc de réduire l’erreur de prévision.
Cependant, il n’est pas réaliste de considérer \(B\) échantillons indépendants.
Cela nécessiterait généralement trop de données. Ces échantillons sont donc remplacés par \(B\) réplications d’échantillons bootstrap obtenus chacun par n tirages avec remise selon la mesure empirique \(\hat F\). Ceci conduit à l’algorithme ci-dessous.
Algorithm : Bagging
Soit \(x_0\) à prévoir et
\(z = \{(x_1, y_1), . . . ,(x_n, y_n)\}\) un échantillon
> for \(b=1\) à \(B\) do
- Tirer un échantillon bootstrap \(z^*_b\)
- Estimer \(\hat{f}_{z_b}(x_0)\) sur l’échantillon bootstrap.
end for
Calculer l’estimation moyenne \(\hat{f}_B(x_0) = \frac{1}{B} \sum_{b=1}^B \hat{f}_{z_b}(x_0)\) ou le résultat du vote.
11
On charge le package adabag
12
On construit un modèle de bagging à l’aide de la fonction bagging avec mfinal
\(=20\) arbres, en laissant les autres réglages par défaut.
On calcule le taux d’erreur sur la base de test.
preds.bagg <- predict(model.bagg, newdata = data.Test)$class # on calcul d'abord les prédictions de l'arbre
t_bag1<-taux.erreur(preds.bagg ,data.Test$Clived)
Le taux d’erreur est de 0.0494 !
13
On construit un modèle de bagging avec 20 arbres de décision à 1 noeud.
set.seed(123)
model.bagg.stump <- bagging(Clived ~., data = data.Train, mfinal = 20, control = options.stump)
On calcule le taux d’erreur sur la base de test.
preds.bagg.stump <- predict(model.bagg.stump, newdata = data.Test)$class # on calcul d'abord les prédictions de l'arbre
t_bag2<-taux.erreur(preds.bagg.stump ,(data.Test$Clived))
Le taux d’erreur est de 0.2222 !
14
set.seed(123)
model.bagg.prof <- bagging(Clived ~., data = data.Train, mfinal = 20, control = options.profond)
On calcule le taux d’erreur sur la base de test.
preds.bagg.prof <- predict(model.bagg.prof, newdata = data.Test)$class # on calcul d'abord les prédictions de l'arbre
t_bag3<-taux.erreur(preds.bagg.prof ,(data.Test$Clived))
Le taux d’erreur est de 0.0519 !
15
Comparons les taux d’erreur obtenus avec chaque méthode.
res.bagg <- data.frame(
model = c("defaut", "stump","profond"),
tx_err= c(round(taux.erreur(preds.bagg ,data.Test$Clived),4),
round(taux.erreur(preds.bagg.stump,data.Test$Clived),4),
round(taux.erreur(preds.bagg.prof ,data.Test$Clived),4)
))
hchart(res.bagg, "bar", hcaes(x = "model", y = "tx_err" ), colorByPoint= TRUE) %>%
hc_plotOptions(
bar= list(
dataLabels= list(
enabled= TRUE
)
)
) %>%
hc_add_theme(hc_theme_flatdark())
Le bagging avec des arbres à noeud unique va toujour fournir le même résultat car chacun des 20 arbre utilise (bagging utilise tous les variable pendant la recherche des variable discriminantes) la variable v4 (la plus discriminante).
On voit clairement l’améloiration apportée par le bagging sur la pérfomance du modèle profond!
On test maintenant l’effet du nombre d’arbres, en calculant le taux d’erreur moyen sur 10 répétitions du modèle profond, pour des valeurs de mfinal égales à 1, 2, 5, 10, 20 et 50.
R
est un language vectorisé, on doit éviter au maximum les bouclesfor
, dans ce cas on utilise la fonctionsapply
pour itérer une fonction sur un veceur de paramètres etreplicate
pour répéter 10 fois :
set.seed(123)
compar <- replicate(10,
sapply( c(1,2,5,10,20,50), function(x) taux.erreur(predict(bagging(Clived ~., data = data.Train, mfinal = x, control = options.profond), newdata = data.Test)$class ,(data.Test$Clived))),simplify = FALSE
)
df <- data.frame(mfinal= c("1","2","5","10","20","50"),
tx_err= sapply(data.frame(matrix(unlist(compar), nrow=length(compar), byrow=T)) ,mean) )
hchart(df, "column", hcaes(x = "mfinal", y = "tx_err" ), colorByPoint= TRUE) %>%
hc_plotOptions(
column= list(
dataLabels= list(
enabled= TRUE
)
)
)
Les forêts aléatoires sont un cas particulier d’algorithme de bagging appliqué aux arbres CART.
Le bagging est appliqué à des arbres binaires de décision en ajoutant un tirage aléatoire de \(m\) variables explicatives parmi les \(p\)
Algorithm : Forêts Aléatoires
Soit \(x_0\) à prévoir et
\(z = \{(x_1, y_1), . . . ,(x_n, y_n)\}\) un échantillon
> for \(b=1\) à \(B\) do
- Tirer un échantillon bootstrap \(z^*_b\)
- Estimer un arbre sur cet échantillon avec randomisation des variables
end for
Calculer l’estimation moyenne \(\hat{f}_B(x_0) = \frac{1}{B} \sum_{b=1}^B \hat{f}_{z_b}(x_0)\) ou le résultat du vote.
Nous allons tester l’effet des différents réglages de l’algorithme. On a vu en cours que la pratique consistait à choisir des arbres profonds et un valeur “faible” du nombre de variables utilisées pour construire chaque arbre.
16
On charge le package randomForest
qui ne fait qu’interfacer le programme original développé en Fortran
par Léo Breiman et Adele Cutler
17
set.seed(123)
library(dplyr)
check_mtry <- replicate(10,
sapply( c(1,2,5,8), function(x) round(taux.erreur(predict(randomForest(Clived ~., data = data.Train,ntree=20,mtry=x), newdata = data.Test) ,(data.Test$Clived)),4) ),simplify = FALSE
)
d <- data.frame(mtry= c("1","2","5","8"),
tx_err= sapply(data.frame(matrix(unlist(check_mtry), nrow=length(check_mtry), byrow=T)) ,mean) )
hchart(d, "column", hcaes(x = "mtry", y = "tx_err" ), colorByPoint= TRUE) %>%
hc_plotOptions(
column= list(
dataLabels= list(
enabled= TRUE
)
)
)
la valeur optimal de mtry
\(=\) 2, on voit clairemet l’impact de nomrbre de variables aléatoires choisit pendant la construction de chaque arbre, un faible nombre implique des arbres qui sont peu corrélés ce qui entraîne une baisse de la variance globale après aggrégation.
18
On va maintenant tester l’effet du nombre d’arbres en traçant l’évolution du taux d’erreur moyen calculé sur \(10\) forêts aléatoires, chacune construite avec la valeur optimale de mtry
\(=2\), en fonction de ntree
, avec ntree
égal à 1, 2, 5, 10, 20, 50, 100, 200 ou 500.
set.seed(123)
library(dplyr)
check_ntree <- replicate(10,
sapply( c(1, 2, 5, 10, 20, 50, 100, 200, 500), function(x) round(taux.erreur(predict(randomForest(Clived ~., data = data.Train,ntree=x,mtry=2), newdata = data.Test) ,(data.Test$Clived)),4) ),simplify = FALSE
)
l <- data.frame(ntree= c("1","2","5","10","20","50","100","200","500"),
tx_err= sapply(data.frame(matrix(unlist(check_ntree), nrow=length(check_ntree), byrow=T)) ,mean) )
library(apexcharter) # dataviz gratuite
apexchart(ax_opts = list(
chart = list(
type = "line"
),
stroke = list(
curve = "smooth"
),
grid = list(
borderColor = "#e7e7e7",
row = list(
colors = c("#f3f3f3", "transparent"),
opacity = 0.5
)
),
fill=list(
type= 'gradient'
),
dataLabels = list(
enabled = TRUE
),
markers = list(style = "inverted", size = 6),
series = list(
list(
name = "taux d'erreur",
data = l$tx_err
)
),
title = list(
text = "Taux d'erreur moyen en fonction de ntree ",
align = "left"
),
xaxis = list(
categories = l$ntree
),
yaxis = list(
show=FALSE
)
))
On s’intéresse maintenant aux méthodes de boosting, qui contrairement aux méthodes de bagging, ne construisent pas des arbres de décision en parallèle, mais de façon séquentielle, chaque arbre se concentrant d’avantage sur les individus les moins bien classés par l’arbre précédent. Ces méthodes fonctionnent bien lorsque les classifieurs sont faibles (fort biais et donc fort variance).
Dans la version originelle de l’algorithme Adaboost
, chaque observation est pondérée par un poids \(w_i\) , et aucune source d’aléa n’est introduite contrairement aux méthodes de bagging. Les résultats de l’algorithme sont donc déterministes : si on lance plusieurs fois la méthode sur le même jeu de données, on obtient exactement les mêmes résultats.
19
On construit un modèle basé sur l’algorithme Adaboost
, avec 20 itérations :
library(adabag)
set.seed(123)
adaboost <- boosting(Clived ~., data=data.Train, boos = TRUE,mfinal=20)
t_boost_1<-taux.erreur(predict(adaboost,newdata = data.Test)$class,data.Test$Clived)
Son taux d’erreur est : 0.0568
20
On construit le même modèle mais cette fois à 1 noeud
set.seed(123)
t_boost_2<-taux.erreur(predict(boosting(Clived ~., data=data.Train, boos = TRUE,mfinal=20,control=rpart.control(maxdepth=1)),newdata = data.Test)$class,data.Test$Clived)
21
On fait de même en utilisant cette fois des arbres de décision profonds.
set.seed(123)
t_boost_3<-taux.erreur(predict(boosting(Clived ~., data=data.Train, boos = TRUE,mfinal=20,control=rpart.control(maxdepth=20)),newdata = data.Test)$class,data.Test$Clived)
22
Comparaison : Boosting vs Bagging
library(dplyr)
compa <- data.frame(tx_er=round( c(t_boost_1,t_boost_2,t_boost_3,t_bag1,t_bag2,t_bag3),4),
model=c("default","stump","profond","default","stump","profond"),
method=c("boosting","boosting","boosting","bagging","bagging","bagging")
)
hchart(compa, "column", hcaes(x = "model", y = "tx_er" ,group = "method"), color = c("#0aaffc", "#0afc6f")) %>%
hc_plotOptions(
column= list(
dataLabels= list(
enabled= TRUE
)
)
)
XGBoost
n’est pas une méthode spécifique, mais une implémentation efficace des méthodes du gradient boosting. Sous R
, cette librairie est disponible dans le package xgboost. Ce package fonctionne un peu différemment des précédents, et a sa propre syntaxe.
23
On charge le package xgboost
24
L’encodage one-hot:
new_tr <- model.matrix(~.+0,data = data.Train[,2:9])
new_ts <- model.matrix(~.+0,data = data.Test[,2:9])
25
Création de deux objets contenant respictivement la base d’apprentissage etla base de test
#convert factor to numeric
labels <- as.numeric(data.Train$Clived)-1
ts_label <- as.numeric(data.Test$Clived)-1
dtrainXG <- xgb.DMatrix(data = new_tr,label = labels)
dtestXG <- xgb.DMatrix(data = new_ts,label =ts_label)
w<-list(train=dtrainXG,test=dtestXG)
26
Application d’algorithme de gradient boosting adapté à la classification binaire avec un nombre des iteration \(nrounds=20\)
set.seed(123)
xgb.fit=xgb.train(nrounds=20,data=dtrainXG,watchlist=w,objective = "binary:logistic", verbose = FALSE, params = list(eval_metric="error"))
le taux d’erreur
[1] 0.07160494
27
Test de l’effet des paramètres l’algorithme :
maxdepth
:set.seed(123)
max_depth_s= 1:20
eff_depth<-sapply( max_depth_s ,
function(x) taux.erreur(
ypred =ifelse(predict(xgb.train(nrounds=100,
data=dtrainXG,
watchlist=w,
objective = "binary:logistic",
verbose = FALSE,
params = list(max_depth=x)),
dtestXG)>=0.5,1,0), yobs = ts_label ) )
apexchart(ax_opts = list(
chart = list(
type = "line",
height= 700
),
stroke = list(
curve = "smooth"
),
grid = list(
borderColor = "#e7e7e7",
row = list(
colors = c("#f3f3f3", "transparent"),
opacity = 0.5
)
),
fill=list(
type= 'gradient'
),
dataLabels = list(
enabled = TRUE
),
markers = list(style = "inverted", size = 6),
series = list(
list(
name = "taux d'erreur",
data = round(eff_depth,4)
)
),
title = list(
text = "Taux d'erreur en fonction de max_depth ",
align = "left"
),
xaxis = list(
categories =max_depth_s
),
yaxis = list(
min= min(eff_depth),
max= max(eff_depth),
show= FALSE
)
))
eta
le taux d’apprentissage en gardant la valuer optimale de max_depth
précedenteset.seed(123)
eta_s= seq(0.1,1,by = 0.05)
eff_eta<-sapply( eta_s ,
function(x) taux.erreur(
ypred =ifelse(predict(xgb.train(nrounds=100,
data=dtrainXG,
watchlist=w,
objective = "binary:logistic",
verbose = FALSE,
params = list(eta=x, max_depth=10)),
dtestXG)>=0.5,1,0), yobs = ts_label ) )
apexchart(ax_opts = list(
chart = list(
type = "line"
),
stroke = list(
curve = "smooth"
),
grid = list(
borderColor = "#e7e7e7",
row = list(
colors = c("#f3f3f3", "transparent"),
opacity = 0.5
)
),
fill=list(
type= 'gradient'
),
dataLabels = list(
enabled = TRUE
),
markers = list(style = "inverted", size = 6),
series = list(
list(
name = "taux d'erreur",
data = round(eff_eta,4)
)
),
title = list(
text = "Taux d'erreur en fonction de eta ",
align = "left"
),
xaxis = list(
categories =eta_s
),
yaxis = list(
min= min(eff_eta),
max=max(eff_eta),
show= FALSE
)
))
Bonus: On peut evaluer les combinaisons des deux paramètres avec une grille de recherche ( grid search)pour trouver la combinaison optimale.
( ⚠️ ce calcul peut etre lent en fonction de la machine la cellule est désactivée dans ce notebook)
xgb_grid = expand.grid(
eta = eta_s,
max_depth = max_depth_s,
nrounds=100,
#les params suivants sont les valeurs par défaut
gamma=0,
colsample_bytree=1,
min_child_weight=1,
subsample=1
)
xgb_trcontrol = trainControl(
method = "cv",
number = 3,
verboseIter = TRUE,
allowParallel = TRUE
)
xgb_train = train(
x = dtrainXG ,
y = as.factor(labels),
metric = "Accuracy",
tuneGrid = xgb_grid,
trControl = xgb_trcontrol,
method = "xgbTree"
)
xgb_train$finalModel
En conclusion on présente les performences des différents modèles qu’on a testé :
set.seed(123)
t_xgb <- taux.erreur(ypred =ifelse(predict(xgb.train(nrounds=100,
data=dtrainXG,
watchlist=w,
objective = "binary:logistic",
verbose = FALSE,
params = list(eta=0.3, max_depth=10)),
dtestXG)>=0.5,1,0), yobs = ts_label )
comp_all <- data.frame(tx_er=round( c(t_boost_1,t_boost_2,t_boost_3,t_bag1,t_bag2,t_bag3,t_xgb),4),
method=c("boosting_default","boosting_stump","boosting_profond",
"bagging_default","bagging_stump","bagging_profond","xgboost")
)
hchart(comp_all, "column", hcaes(x = "method", y = "tx_er" ), colorByPoint= TRUE) %>%
hc_plotOptions(
column= list(
dataLabels= list(
enabled= TRUE
)
)
)
On selectionne le meilleur algorithme pour réaliser des prédistions sur la nouvelle base 746Data
data746 <- read.csv("746Data.txt")
new_df <- data.frame(matrix(unlist(strsplit(as.character(data746$Octamer),'',fixed=FALSE)),
nrow=length(strsplit(as.character(data746$Octamer),'',fixed=FALSE)),
byrow=T))
colnames(new_df)<-c('v1','v2','v3','v4','v5','v6','v7','v8')
data746<- cbind(data746,new_df)[,-1]
data746$Clived<-factor(data746$Clived,labels = c(0,1))
head(data746)
Clived | v1 | v2 | v3 | v4 | v5 | v6 | v7 | v8 |
---|---|---|---|---|---|---|---|---|
0 | A | A | A | K | F | E | R | Q |
0 | A | A | A | M | K | R | H | G |
0 | A | A | A | M | S | S | A | I |
0 | A | A | K | F | E | R | Q | H |
0 | A | A | K | F | E | S | N | F |
0 | A | A | M | K | R | H | G | L |
On calcule ensuite le taux d’erreur de notre modèle :
set.seed(123)
# taux.erreur(predict(boosting(Clived ~., data=data.Train, boos = TRUE,mfinal=20,control=rpart.control(maxdepth=20)),newdata = data746)$class,data746$Clived)
testDM <- xgb.DMatrix(data = model.matrix(~.+0,data = data746[,2:9]),
label = as.numeric(data746$Clived)-1)
taux.erreur(ypred =ifelse(predict(xgb.train(nrounds=100,
data=dtrainXG,
watchlist=w,
objective = "binary:logistic",
verbose = FALSE,
params = list(eta=0.3, max_depth=10)),
testDM)>=0.5,1,0), yobs = as.numeric(data746$Clived)-1 )
[1] 0.04959786
Pour finir, deux types d’algorithmes ont été abordés. Ceux reposants sur une construction aléatoires d’une famille de modèles : bagging pour bootstrap aggregating (Breiman 1996) et les forêts aléatoires (random forests) de Breiman (2001) qui propose une amélioration du bagging spécifique aux modèles définis par des arbres binaires (CART).
Ceux basés sur le boosting (Freundet Shapiro,1996) et qui reposent sur une construction adaptative, déterministe ou aléatoire, d’une famille de modèles. Ces algorithmes se sont développés à la frontière entre apprentissage machine ( machine learning ) et Statistique.
Les principes du bagging ou du boosting s’appliquent à toute méthode de modélisation (régression, CART, réseaux de neurones) mais n’ont d’intérêt, et réduisent sensiblement l’erreur de prévision, que dans le cas de modèles instables. Ils sont surtout mis en œuvre en association avec des arbres binaires comme modèles de base. En effet, l’instabilité déjà soulignés des arbres apparaît alors comme une propriété nécessaire à la réduction de la variance par agrégation de modèles.