Tree bases
## Warning: package 'lmtest' was built under R version 3.4.4Classification trees
les arbres de décisions sont utilisés pour en machine learning supervisée afin de pouvoir faire des prédictions. les utilités tournent autour de l’interprétabilité des résultats. la facilité d’utilisation
les performances (accuracy)
souvent utilisé par les datascientists , mais aussi par les preneurs de décision et les managers (afin d’orinter un politique)
-Nous verrons comment interpreter et expliques les decisions
- Nous explorerons differentes modalités - Nous verrons comment constuire et evaluer les models de classifications et de regression.
- Nous verrons aussi comment parametrer pour des meilleurs performances de modéles.
les thémes à voir seront :
* Classification et arbre de regression
* Bagged Trees
* Random Forest
* Boosted Trees (particuliérement gradient boost méthode)
la terminologie se base sur principalement les root node et les internal node et les leaf node
le package le plus connu est le package rpart
# structure de donnée
str(creditsub)## 'data.frame': 522 obs. of 5 variables:
## $ months_loan_duration: int 6 48 12 42 24 36 24 36 12 30 ...
## $ percent_of_income : int 4 2 2 2 3 2 3 2 2 4 ...
## $ years_at_residence : int 4 2 3 4 4 4 4 2 4 2 ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ default : int 1 2 1 1 2 1 1 1 1 2 ...# crée le model
credit_model <- rpart(formula = default ~ .,
data = creditsub, method = "class")
credit_model## n= 522
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 522 144 1 (0.7241379 0.2758621)
## 2) months_loan_duration< 20.5 309 61 1 (0.8025890 0.1974110) *
## 3) months_loan_duration>=20.5 213 83 1 (0.6103286 0.3896714)
## 6) months_loan_duration< 43.5 179 64 1 (0.6424581 0.3575419)
## 12) age>=23.5 162 55 1 (0.6604938 0.3395062)
## 24) percent_of_income< 3.5 68 17 1 (0.7500000 0.2500000) *
## 25) percent_of_income>=3.5 94 38 1 (0.5957447 0.4042553)
## 50) months_loan_duration< 29 54 17 1 (0.6851852 0.3148148) *
## 51) months_loan_duration>=29 40 19 2 (0.4750000 0.5250000)
## 102) years_at_residence>=3.5 18 7 1 (0.6111111 0.3888889) *
## 103) years_at_residence< 3.5 22 8 2 (0.3636364 0.6363636) *
## 13) age< 23.5 17 8 2 (0.4705882 0.5294118) *
## 7) months_loan_duration>=43.5 34 15 2 (0.4411765 0.5588235)
## 14) age>=25.5 24 11 1 (0.5416667 0.4583333)
## 28) years_at_residence< 3.5 13 4 1 (0.6923077 0.3076923) *
## 29) years_at_residence>=3.5 11 4 2 (0.3636364 0.6363636) *
## 15) age< 25.5 10 2 2 (0.2000000 0.8000000) *# plot resultat
rpart.plot(x =credit_model , yesno = 2, type = 0, extra = 0) 
Les arbres ont des avantages tout comme des désavantages .
Par exemple comparés aux modéles de regression , les arbres sont plus simple à interpréter , à comprendre et surtout à visualiser .
les parties training (comme au dessus ) et la partie predictions sont facile à expliquer.
les arbres peuvent supporter à la fois les variables numériques et catégorielles.
les arbres aussi supportes beaucoup mieux et de maniére beaucoup simple les NA. Cela en choisissant dans ce cas d’aller à gauches ou à droite aléatoirement, ou d’aller gauche et à droite et ensuite de lisser une fois arriver au leaf node pour la prediction finale.
Les arbres sont aussi connus pour être beaucoup plus robust au outliers ( vu que les données peuvent être utilisées souvent sans modification de leurs structures). Et d’ailleurs pour ces mêmes raisons ces modéles nécessitent peu de préparation de données.
les arbres de décision récursivement divise les espaces de fonctionnalités en sous-ensemble(comme ci dessus ). ce qui rends les frontriére de decision beaucoup plus complexe.
c’est qui leurs permet d’ailleurs de gerer le manquante de linéarité dans les données.
Au niveau des performances l’apprentissage est trés rapide est ceux même sur des grosse base de données.
Cependant les grosses arbres de decisions sont difficile à interpréter. la variance trop élevée dans les arbres de décision peuvent souvent jouer sur les performances.
Si les parametres ne sont pas mise en place correctement, peuvent créer des arbres trop complexes(overfitting). Pour éviter les overfitting, il faut de préférence couper les donnée en 80/20 pour Train/test.
Test/Train
# pour Train/test
# recuprer le nombre d'observation
n=nrow(creditsub)
# nombre de ligne pour le train
n_train=round(0.80*n) #fonction round fait l'arrondi
# nombre de ligne pour test
n_test=round(0.2*n)
# creation de vecteur de taille n_train aléatoire de 1:n
set.seed(123) # pour que le même phénoméne aléatoire soit reproductible
train_indices= sample(1:n, n_train)
# data train
credit_train=creditsub[train_indices,]
# data test
credit_test=creditsub[-train_indices,] # en excluant les indices du trainPour Train de base
# Pour Apprentissage
credit_model <- rpart(formula = default ~., # le point pour prendre tout les regresseurs
data = credit_train,
method = "class") # classification de base pour response binaire
# Pour visualiser le model
p=print(credit_model)## n= 418
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 418 115 1 (0.7248804 0.2751196)
## 2) months_loan_duration< 28.5 331 74 1 (0.7764350 0.2235650) *
## 3) months_loan_duration>=28.5 87 41 1 (0.5287356 0.4712644)
## 6) age>=34.5 39 13 1 (0.6666667 0.3333333)
## 12) age< 52 28 6 1 (0.7857143 0.2142857) *
## 13) age>=52 11 4 2 (0.3636364 0.6363636) *
## 7) age< 34.5 48 20 2 (0.4166667 0.5833333)
## 14) percent_of_income< 3.5 25 12 1 (0.5200000 0.4800000)
## 28) percent_of_income>=1.5 17 7 1 (0.5882353 0.4117647) *
## 29) percent_of_income< 1.5 8 3 2 (0.3750000 0.6250000) *
## 15) percent_of_income>=3.5 23 7 2 (0.3043478 0.6956522) *Pour évaluer la performance du modéle
# Faire prediction
p=predict(credit_model,
credit_test) # fait comme çà , nous avons juste proba mais pas les classification
head(p) #1=oui 2=no## 1 2
## 5 0.7764350 0.2235650
## 8 0.7857143 0.2142857
## 9 0.7764350 0.2235650
## 11 0.7764350 0.2235650
## 18 0.5882353 0.4117647
## 20 0.7764350 0.2235650# Pour faire la classifiction directement
class_prediction=predict(object = credit_model,
newdata=credit_test,
type="class")
head(class_prediction,30)## 5 8 9 11 18 20 27 33 37 38 42 43 48 51 59 64 71 78
## 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 1
## 85 98 100 103 104 106 110 113 117 123 132 136
## 1 1 1 1 1 1 1 1 2 1 2 1
## Levels: 1 2Il y a difference maniére d’évaluer la performance d’un modéle.
Accuracy (ratio entre le nombre de prediction et le nombre total de prediction)
Confusion Matrix (Vient complément de l’accuracy pour montrer les Vrais et faux positives, négative et eventuellement pointer dans quel domaine le model peinerait à faire de prédiction )
# Calcule confusion matrix pour test set
conf=confusionMatrix(class_prediction,
credit_test$default) Log-loss
AUC (area under the curve (ROC))
Critére de création de sous groupe (ensemble) homogéne
Pour definir l’homogénieté des sous ensemble de l’arbre nous utilisons l’indice de Gini , qui mesure la Pureté ou l’impureté des sous groupe. Plus le gini est petit plus les sous groupe sont homogéne (pure) . Nous pouvons aussi choisir de le faire avec le critére d’information.
# Train avec gini model
credit_model1 <- rpart(formula = default ~ .,
data = credit_train,
method = "class",
parms = list(split = "gini"))
# Train avec information-based model
credit_model2 <- rpart(formula = default ~ .,
data = credit_train,
method = "class",
parms = list(split = "information"))
# Prediction pour gini
pred1 <- predict(object = credit_model1,
newdata = credit_test,
type = "class")
# Prediction pour Information
pred2 <- predict(object = credit_model2,
newdata = credit_test,
type = "class")
# Compare classification erreur (ce)
error_gini =ce(actual = credit_test$default, # Package Modelmetrics
predicted = pred1)
error_info=ce(actual = credit_test$default,
predicted = pred2) Regression Trees
Le but du regression trees est prédire une variable avec une valeur numérique. Que ce soit Entier
ou Réel . Par exemple le poid , le prix …..
Pour Cette Partie nous utiliserons la base de donnée de sur la performance des étudiants.
Note= read.csv("~/Desktop/Note.txt")
# Randomly assign rows to ids (1/2/3 represents train/valid/test)
# Pour train/validation/test split 70% / 15% / 15% (aléatoirement)
set.seed(1)
assignment <- sample(1:3, size = nrow(Note), prob =c(0.7,0.15,0.15), replace = TRUE)
# Crée train, validation and tests À partir de Note
Note_train = Note[assignment == 1, ] # subset training
Note_valid = Note[assignment == 2, ] # subset validation
Note_test = Note[assignment == 3, ] # subset test
# Train model
Note_model <- rpart(formula = final_grade ~ .,
data = Note_train,
method = "anova") # Option pour regression trees
# Plot du tree model
rpart.plot(x =Note_model,
yesno = 2, # Affiche les Yesno
type = 0,
extra = 0)
Les deux outils de mesure de performances sont :
- MAE (mean Absolute Error)
- RMSE (Root mean Square Error)
# predictions test set
pred <- predict(object = Note_model,
newdata =Note_test)
# Compute le RMSE
RMSE=rmse(actual = Note_test$final_grade,
predicted = pred) #package MetricsLes Hyperparamétres
?rpart.control
# minsplit ->
#le nombre minimum d'individu homogéne pour créer un sous groupe (default 12)
# cp -> la complexité (default 0.1) plus c'est petit
#plus l'arbre est susceptible d'être complexe
# maxdepth -> le nombre max de noeud entre le Root node et le leaf node
#(default 30 pour permettre le construction de trés grands arbres )
# Plot "CP Table" (pour voir le plus optimal pour le modéle)
plotcp(Note_model)
# Affiche le tableau "CP Table"
print(Note_model$cptable)## CP nsplit rel error xerror xstd
## 1 0.06839852 0 1.0000000 1.0080595 0.09215642
## 2 0.06726713 1 0.9316015 1.0920667 0.09543723
## 3 0.03462630 2 0.8643344 0.9969520 0.08632297
## 4 0.02508343 3 0.8297080 0.9291298 0.08571411
## 5 0.01995676 4 0.8046246 0.9357838 0.08560120
## 6 0.01817661 5 0.7846679 0.9337462 0.08087153
## 7 0.01203879 6 0.7664912 0.9092646 0.07982862
## 8 0.01000000 7 0.7544525 0.9407895 0.08399125# Recupére la valeur optimal aprés Cross-validation
opt_index <- which.min(Note_model$cptable[, "xerror"])
cp_opt <- Note_model$cptable[opt_index, "CP"]
# Prune the model (to optimized cp value)
Note_model_opt <- prune(tree = Note_model,
cp = cp_opt)
# Plot the optimized model
rpart.plot(x = Note_model_opt, yesno = 2, type = 0, extra = 0)
Selection Modéle : Grid Search
Permet de pouvoir trouver les meilleurs Hyperparamétres
# Etablir une liste possible de ces deux paramétres
minsplit <- seq(1, 4, 1)
maxdepth <- seq(1, 6, 1)
# Créer un dataframe contenant toute les combinaisons possibles
hyper_grid <- expand.grid(minsplit = minsplit, maxdepth = maxdepth)
# Vérification
head(hyper_grid)# Print nombre de grid combinaison possible
nrow(hyper_grid) ## [1] 24# Nombre potentiels de modéle dans le grid
num_models <- nrow(hyper_grid)
# Crée un list vide pour stocker les modéles
Note_models <- list()
# Boucle Apprentissage Modéle pour chaque grid
for (i in 1:num_models) {
# Get minsplit, maxdepth values at row i
minsplit <- hyper_grid$minsplit[i]
maxdepth <- hyper_grid$maxdepth[i]
# Train a model and store in the list
Note_models[[i]] <- rpart(formula = final_grade ~ .,
data = Note_train,
method = "anova",
minsplit = minsplit,
maxdepth = maxdepth)
}
# Crée un vecteur vide pour enregistrer les valeurs des RMSE
rmse_values <- c()
# Boucle pour recupérer les rmse des modéles à partir du grid
for (i in 1:num_models) {
# Recupére le modéle i
model <- Note_models[[i]]
# Generate predictions on grade_valid
pred <- predict(object = model,
newdata = Note_valid)
# Compute validation RMSE et l'ajoute
rmse_values[i] <- rmse(actual = Note_valid$final_grade,
predicted = pred)
}
# Identifie le modéle avec le plus petit RMSE
best_model <- Note_models[[which.min(rmse_values)]]
# Affiche les Hyperparamétre du meilleur modéle
best_model$control## $minsplit
## [1] 2
##
## $minbucket
## [1] 1
##
## $cp
## [1] 0.01
##
## $maxcompete
## [1] 4
##
## $maxsurrogate
## [1] 5
##
## $usesurrogate
## [1] 2
##
## $surrogatestyle
## [1] 0
##
## $maxdepth
## [1] 1
##
## $xval
## [1] 10# Compute test set RMSE sur best_model
dt_pred <- predict(object = best_model,
newdata = Note_test)
rmse(actual = Note_test$final_grade,
predicted = dt_pred)## [1] 2.124109Bagged Trees (Bootstrap aggregating)
Contre mesure pour la complexite de certains des Arbres qui créent une variance trop grande dans les estimation et peut méner à l’erreur.
Cette méthode mets en place plusieurs arbres pour reduire la variance. Avant de faire la moyenne pour la predictions finale. Cette méthode est basée sur la technique du bootstrap.
modéle
# C'est un phénoméne aléatoire
# On paramétre set seed (123) pour la reproductibilité des mêmes données
set.seed(123)
# Train bagged model
credit_model <- bagging(formula = default ~ .,
data = credit_train,
coob = TRUE) # Pour estimer le Accurracy
# Print model
print(credit_model) ##
## Bagging regression trees with 25 bootstrap replications
##
## Call: bagging.data.frame(formula = default ~ ., data = credit_train,
## coob = TRUE)
##
## Out-of-bag estimate of root mean squared error: 0.4485Performance
credit_model= rpart(default~.,
data= credit_train,
method = "class")
# prediction utilsant credit_test
class_prediction <- predict(object = credit_model,
newdata =credit_test,
type = "class") # return avec classification
# Print predicted classes
print(class_prediction)## 5 8 9 11 18 20 27 33 37 38 42 43 48 51 59 64 71 78
## 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 1
## 85 98 100 103 104 106 110 113 117 123 132 136 146 152 159 168 178 188
## 1 1 1 1 1 1 1 1 2 1 2 1 2 1 1 1 1 1
## 189 195 207 211 212 214 218 236 242 244 245 246 255 257 259 260 268 271
## 1 2 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1
## 275 276 286 293 297 300 302 312 315 324 325 329 330 332 335 336 337 345
## 2 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1
## 354 356 363 375 380 382 394 396 398 403 404 410 414 415 417 422 427 429
## 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 438 446 449 450 451 473 477 484 492 496 498 500 501 509
## 1 1 1 1 2 1 2 1 1 1 1 1 1 1
## Levels: 1 2# Calcul le confusion matrix avec les mesure de performance
caret::confusionMatrix( data=class_prediction,
reference= credit_test$default) ## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 2
## 1 69 23
## 2 6 6
##
## Accuracy : 0.7212
## 95% CI : (0.6247, 0.8046)
## No Information Rate : 0.7212
## P-Value [Acc > NIR] : 0.549830
##
## Kappa : 0.1547
## Mcnemar's Test P-Value : 0.002967
##
## Sensitivity : 0.9200
## Specificity : 0.2069
## Pos Pred Value : 0.7500
## Neg Pred Value : 0.5000
## Prevalence : 0.7212
## Detection Rate : 0.6635
## Detection Prevalence : 0.8846
## Balanced Accuracy : 0.5634
##
## 'Positive' Class : 1
## # Fait prediction sur credit_test
pred <- predict(object =credit_model,
newdata = credit_test,
type = "prob")
# `pred`
class(pred)## [1] "matrix"# Look at the pred format
head(pred)## 1 2
## 5 0.7764350 0.2235650
## 8 0.7857143 0.2142857
## 9 0.7764350 0.2235650
## 11 0.7764350 0.2235650
## 18 0.5882353 0.4117647
## 20 0.7764350 0.2235650# Compute le AUC (`actual` est binaire et prend 0 ou 1)
bag_auc=auc(actual = ifelse(credit_test$default == "1", 1, 0),
predicted = pred[,"1"]) Cross Validation (K-fold)
Méthode base sur le bootstrap qui renvoie à la fin un accuracy moyen par rapport au prediction des sous modéles.
# Specifier les configuration du training
ctrl <- trainControl(method = "cv", # Cross-validation
number = 5, # 5 folds
classProbs = TRUE, # For AUC (pour considérer les classes)
summaryFunction = twoClassSummary) # For AUC (classification binaire)
# caret est tres sensible au type facteur
credit_train$default= as.character(credit_train$default) %>%
str_replace_all(pattern="1", replacement = "yes")%>%
str_replace_all(pattern = "2", replacement = "no")
credit_test$default= as.character(credit_test$default) %>%
str_replace_all(pattern="1", replacement = "yes")%>%
str_replace_all(pattern = "2", replacement = "no")
# Cross validée le credit model utilisant la method "treebag" ;
# En relatant le AUC (Area under the ROC curve)
set.seed(1) # Pour la reproductibilité
credit_caret_model <-caret::train(default ~.,
data = credit_train,
method = "treebag",
metric = "ROC",
trControl = ctrl)
# Print Model
print(credit_caret_model)## Bagged CART
##
## 418 samples
## 4 predictor
## 2 classes: 'no', 'yes'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 335, 334, 334, 334, 335
## Resampling results:
##
## ROC Sens Spec
## 0.5968021 0.3478261 0.8115301# Inspecter le contenu
names(credit_caret_model)## [1] "method" "modelInfo" "modelType" "results"
## [5] "pred" "bestTune" "call" "dots"
## [9] "metric" "control" "finalModel" "preProcess"
## [13] "trainingData" "resample" "resampledCM" "perfNames"
## [17] "maximize" "yLimits" "times" "levels"
## [21] "terms" "coefnames" "xlevels"# Print the CV AUC
credit_caret_model$results[,"ROC"] ## [1] 0.5968021# prediction
bg_pred <- predict(object = credit_caret_model,
newdata =credit_test,
type = "prob")
# Compute le AUC (`actual` est binaire et prend 0 ou 1)
auc(actual = ifelse(credit_test$default == "yes", 1, 0),
predicted = bg_pred[,"yes"]) ## [1] 0.5172414Random Forest
C’est une amélioration Basée sur bagged trees Donne souvent de meilleur performances et n’a pas forcément besoin de Test/train.` Toutefois les mesures comme AUC , log-loss… ne sont compris dans le package du randomForest, qui d’ailleurs ne prend en compte de comparaison possible avec d’autre methode d’estimation.
# caret est tres sensible au type facteur
credit_train$default= credit_train$default %>%
as.factor()
credit_test$default= credit_test$default %>%
as.factor()
# Train Random Forest
set.seed(1) # Pour le reproductibilité
credit_model <- randomForest(formula = default ~.,
data = credit_train)
# Print model output
print(credit_model) ##
## Call:
## randomForest(formula = default ~ ., data = credit_train)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 32.54%
## Confusion matrix:
## no yes class.error
## no 26 89 0.7739130
## yes 47 256 0.1551155 # OOB l'erreur moyen dans les predictions Out-of-bagperformance
# Matrice des OOB error
err <- credit_model$err.rate
head(err)## OOB no yes
## [1,] 0.3417722 0.7674419 0.1826087
## [2,] 0.3686275 0.6818182 0.2592593
## [3,] 0.3650794 0.6867470 0.2500000
## [4,] 0.3644068 0.6063830 0.2769231
## [5,] 0.3557951 0.6969697 0.2316176
## [6,] 0.3624679 0.6952381 0.2394366# montre le dernier OOB error
oob_err <- err[nrow(err), "OOB"]
print(oob_err)## OOB
## 0.3253589# Plot le model (error)
plot(credit_model)
legend(x = "right",
legend = colnames(err),
fill = 1:ncol(err)) 
# predict train
class_prediction <- predict(object = credit_model, # model
newdata = credit_test, # test dataset
type = "class") # retourne classification
# Calcule le confusion matrix pour le test set
cm <-caret:: confusionMatrix(data = class_prediction, # Classes predites
reference = credit_test$default) # Classe observés
print(cm)## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 7 10
## yes 22 65
##
## Accuracy : 0.6923
## 95% CI : (0.5942, 0.7791)
## No Information Rate : 0.7212
## P-Value [Acc > NIR] : 0.77992
##
## Kappa : 0.1237
## Mcnemar's Test P-Value : 0.05183
##
## Sensitivity : 0.24138
## Specificity : 0.86667
## Pos Pred Value : 0.41176
## Neg Pred Value : 0.74713
## Prevalence : 0.27885
## Detection Rate : 0.06731
## Detection Prevalence : 0.16346
## Balanced Accuracy : 0.55402
##
## 'Positive' Class : no
## # Compare le test set accuracy au OOB accuracy
paste0("Test Accuracy: ", cm$overall[1])## [1] "Test Accuracy: 0.692307692307692"paste0("OOB Accuracy: ", 1 - oob_err) ## [1] "OOB Accuracy: 0.674641148325359"# Predict sur credit_test
rf_pred <- predict(object = credit_model,
newdata =credit_test,
type = "prob")
# Compute le AUC (`actual` est binaire et prend 0 ou 1)
auc(actual = ifelse(credit_test$default == "yes", 1, 0),
predicted = rf_pred[,"yes"]) ## [1] 0.5485057Hyperparametres
# Execute le tuning process
set.seed(1)
res <- tuneRF(x = subset(credit_train, select = -default),
y =credit_train$default,
ntreeTry = 500) # Nombre max de arbres## mtry = 2 OOB error = 32.54%
## Searching left ...
## mtry = 1 OOB error = 27.75%
## 0.1470588 0.05
## Searching right ...
## mtry = 4 OOB error = 33.25%
## -0.1982759 0.05
# Look at results
print(res)## mtry OOBError
## 1.OOB 1 0.2775120
## 2.OOB 2 0.3253589
## 4.OOB 4 0.3325359# trouve le mtry que minimise le OOB error
mtry_opt <- res[,"mtry"][which.min(res[,"OOBError"])]
print(mtry_opt)## 1.OOB
## 1# Si on veut juste retrouner le best RF modéle (plus que les resultats)
# set `doBest = TRUE` dans `tuneRF()` Pour retourner le best modéle
# Au lieu de set performance matrix.
mtry <- seq(4, ncol(credit_train) * 0.8, 2) # nombre max de variable à choisir aléatoirement
nodesize <- seq(3, 8, 2) # Nombre de noeud max
sampsize <- nrow(credit_train) * c(0.7, 0.8) # taille du train
# Créer un dataframe avec toute les combinaisons possible
hyper_grid <- expand.grid(mtry = mtry, nodesize = nodesize, sampsize = sampsize)
# Vecteur vide pour stocker les OOB error
oob_err <- c()
# Boucle pour faire un train avec chaque combinaison de paramétre
for (i in 1:nrow(hyper_grid)) {
# Train Random Forest
model <- randomForest(formula = default ~ .,
data = credit_train,
mtry = hyper_grid$mtry[i],
nodesize = hyper_grid$nodesize[i],
sampsize = hyper_grid$sampsize[i])
# Recupére OOB error du model
oob_err[i] <- model$err.rate[nrow(model$err.rate), "OOB"]
}
# Identifie le hyperparamétre optimal en fonction des OOB error
opt_i <- which.min(oob_err)
print(hyper_grid[opt_i,]) ## mtry nodesize sampsize
## 3 4 7 292.6Boosting (gbm)
Un bon paramétrage du GBM (qui est un modification du Adaboost), peut desfois même surpasser la performance d’autre méthode comme le neural network, et les autres algorithmes. Cependant elle peut être souvent sur évaluer , et est aussi sensible aux outliers et aux bruits.
# Convertit "yes" to 1, "no" to 0
credit_train$default <- ifelse(credit_train$default == "yes", 1, 0)
credit_test$default<- ifelse(credit_test$default == "yes", 1, 0)
# Train avec 10000-tree
set.seed(1)
credit_model <- gbm(formula = default ~ .,
distribution = "bernoulli", # pour deux class
data = credit_train,
n.trees = 10000)
# Print model
print(credit_model)## gbm(formula = default ~ ., distribution = "bernoulli", data = credit_train,
## n.trees = 10000)
## A gradient boosted model with bernoulli loss function.
## 10000 iterations were performed.
## There were 4 predictors of which 4 had non-zero influence.# summary() prints l'importance des variable
summary(credit_model) 
# Prediction
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = 10000) # Nombre d'arbre à utiliser dans la prediction
# Prediction (avec response)
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees = 10000,
type = "response")
# Compare compare les intervalles de prediction
range(preds1)## [1] -0.8345362 2.3199095range(preds2)## [1] 0.3026868 0.9105126# Generate les AUC
auc(actual = credit_test$default, predicted = preds1) #default## [1] 0.654023auc(actual = credit_test$default, predicted = preds2) #rescaled ## [1] 0.654023Hyperparamétres
# le ntree optimal pour OOB
ntree_opt_oob <- gbm.perf(object = credit_model,
method = "OOB",
oobag.curve = TRUE)## Warning in gbm.perf(object = credit_model, method = "OOB", oobag.curve
## = TRUE): OOB generally underestimates the optimal number of iterations
## although predictive performance is reasonably competitive. Using cv.folds>0
## when calling gbm usually results in improved predictive performance.
# Train avec Cross validation GBM model
set.seed(1)
credit_model_cv <- gbm(formula = default ~ .,
distribution = "bernoulli",
data = credit_train,
n.trees = 10000,
cv.folds = 2)
# ntree optimal pour CV
ntree_opt_cv <- gbm.perf(object = credit_model_cv,
method = "cv")
# Compare compare les estimations
print(paste0("Optimal n.trees (OOB Estimate): ", ntree_opt_oob)) ## [1] "Optimal n.trees (OOB Estimate): 1140"print(paste0("Optimal n.trees (CV Estimate): ", ntree_opt_cv)) ## [1] "Optimal n.trees (CV Estimate): 1715"# prediction sur credit_test apres de ntree_opt_oob nombre de trees
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = ntree_opt_oob)
# prediction sur credit_test apres de ntree_opt_cv nombre de trees
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees =ntree_opt_cv ) Performance
# prediction sur credit_test apres de ntree_opt_oob nombre de trees
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = ntree_opt_oob, type="response")
# prediction sur credit_test apres de ntree_opt_cv nombre de trees
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees =ntree_opt_cv )
# Generate the test set AUCs using the two sets of preditions & compare
auc1 <- auc(actual = credit_test$default, predicted = preds1) #OOB
auc2 <- auc(actual = credit_test$default, predicted = preds2) #CV
# Compare AUC
print(paste0("Test set AUC (OOB): ", auc1)) ## [1] "Test set AUC (OOB): 0.662068965517241"print(paste0("Test set AUC (CV): ", auc2)) ## [1] "Test set AUC (CV): 0.657471264367816"# List of predictions
preds_list <- list(preds1,preds2)
# List of actual values (same for all)
m <- length(preds_list)
actuals_list <- rep(list(credit_test$default), m)
# Plot the ROC curves
pred <- prediction(preds_list, actuals_list)
rocs <- performance(pred, "tpr", "fpr")
plot(rocs, col = as.list(1:m), main = "Test Set ROC Curves")
legend(x = "bottomright",
legend = c("OOB", "CV"),
fill = 1:m)
CODE
1
library(ggplot2)
library(magrittr)
library(rmarkdown)
library(dplyr)
library(tidyr)
library(RColorBrewer)
library(reshape2)
library(ggthemes)
library(MASS)
library(viridis)
library(GSIF)
library(ggtern)
library(geomnet)
library(ggmap)
library(ggfortify)
library(vars)
library(maps)
library(rgdal)
library(animation)
library(class)
library(combinat)
library(rpart)
library(rpart.plot)
library(caret)
library(ModelMetrics)
library(Metrics)
library(ipred)
library(stringr)
library(randomForest)
library(gbm)
library(ROCR)
f=file(
"https://archive.ics.uci.edu/ml/machine-learning-databases/statlog/german/german.data")
creditData <- read.table(f,col.names =paste0("X","1":"21") ,sep=" ")
creditsub=creditData[1:522,c(2,8,11,13,21)]
names(creditsub)=c("months_loan_duration","percent_of_income",
"years_at_residence","age","default")
# structure de donnée
str(creditsub)
# crée le model
credit_model <- rpart(formula = default ~ .,
data = creditsub, method = "class")
credit_model
# plot resultat
rpart.plot(x =credit_model , yesno = 2, type = 0, extra = 0)
# pour Train/test
# recuprer le nombre d'observation
n=nrow(creditsub)
# nombre de ligne pour le train
n_train=round(0.80*n) #fonction round fait l'arrondi
# nombre de ligne pour test
n_test=round(0.2*n)
# creation de vecteur de taille n_train aléatoire de 1:n
set.seed(123) # pour que le même phénoméne aléatoire soit reproductible
train_indices= sample(1:n, n_train)
# data train
credit_train=creditsub[train_indices,]
# data test
credit_test=creditsub[-train_indices,] # en excluant les indices du train
# Pour Apprentissage
credit_model <- rpart(formula = default ~., # le point pour prendre tout les regresseurs
data = credit_train,
method = "class") # classification de base pour response binaire
# Pour visualiser le model
p=print(credit_model)
# Faire prediction
p=predict(credit_model,
credit_test) # fait comme çà , nous avons juste proba mais pas les classification
head(p) #1=oui 2=no
# Pour faire la classifiction directement
class_prediction=predict(object = credit_model,
newdata=credit_test,
type="class")
head(class_prediction,30)
# Calcule confusion matrix pour test set
conf=confusionMatrix(class_prediction,
credit_test$default)
# Train avec gini model
credit_model1 <- rpart(formula = default ~ .,
data = credit_train,
method = "class",
parms = list(split = "gini"))
# Train avec information-based model
credit_model2 <- rpart(formula = default ~ .,
data = credit_train,
method = "class",
parms = list(split = "information"))
# Prediction pour gini
pred1 <- predict(object = credit_model1,
newdata = credit_test,
type = "class")
# Prediction pour Information
pred2 <- predict(object = credit_model2,
newdata = credit_test,
type = "class")
# Compare classification erreur (ce)
error_gini =ce(actual = credit_test$default, # Package Modelmetrics
predicted = pred1)
error_info=ce(actual = credit_test$default,
predicted = pred2) 2
Note= read.csv("~/Desktop/Note.txt")
# Randomly assign rows to ids (1/2/3 represents train/valid/test)
# Pour train/validation/test split 70% / 15% / 15% (aléatoirement)
set.seed(1)
assignment <- sample(1:3, size = nrow(Note), prob =c(0.7,0.15,0.15), replace = TRUE)
# Crée train, validation and tests À partir de Note
Note_train = Note[assignment == 1, ] # subset training
Note_valid = Note[assignment == 2, ] # subset validation
Note_test = Note[assignment == 3, ] # subset test
# Train model
Note_model <- rpart(formula = final_grade ~ .,
data = Note_train,
method = "anova") # Option pour regression trees
# Plot du tree model
rpart.plot(x =Note_model,
yesno = 2, # Affiche les Yesno
type = 0,
extra = 0)
# predictions test set
pred <- predict(object = Note_model,
newdata =Note_test)
# Compute le RMSE
RMSE=rmse(actual = Note_test$final_grade,
predicted = pred) #package Metrics
?rpart.control
# minsplit ->
#le nombre minimum d'individu homogéne pour créer un sous groupe (default 12)
# cp -> la complexité (default 0.1) plus c'est petit
#plus l'arbre est susceptible d'être complexe
# maxdepth -> le nombre max de noeud entre le Root node et le leaf node
#(default 30 pour permettre le construction de trés grands arbres )
# Plot "CP Table" (pour voir le plus optimal pour le modéle)
plotcp(Note_model)
# Affiche le tableau "CP Table"
print(Note_model$cptable)
# Recupére la valeur optimal aprés Cross-validation
opt_index <- which.min(Note_model$cptable[, "xerror"])
cp_opt <- Note_model$cptable[opt_index, "CP"]
# Prune the model (to optimized cp value)
Note_model_opt <- prune(tree = Note_model,
cp = cp_opt)
# Plot the optimized model
rpart.plot(x = Note_model_opt, yesno = 2, type = 0, extra = 0)
# Etablir une liste possible de ces deux paramétres
minsplit <- seq(1, 4, 1)
maxdepth <- seq(1, 6, 1)
# Créer un dataframe contenant toute les combinaisons possibles
hyper_grid <- expand.grid(minsplit = minsplit, maxdepth = maxdepth)
# Vérification
head(hyper_grid)
# Print nombre de grid combinaison possible
nrow(hyper_grid)
# Nombre potentiels de modéle dans le grid
num_models <- nrow(hyper_grid)
# Crée un list vide pour stocker les modéles
Note_models <- list()
# Boucle Apprentissage Modéle pour chaque grid
for (i in 1:num_models) {
# Get minsplit, maxdepth values at row i
minsplit <- hyper_grid$minsplit[i]
maxdepth <- hyper_grid$maxdepth[i]
# Train a model and store in the list
Note_models[[i]] <- rpart(formula = final_grade ~ .,
data = Note_train,
method = "anova",
minsplit = minsplit,
maxdepth = maxdepth)
}
# Crée un vecteur vide pour enregistrer les valeurs des RMSE
rmse_values <- c()
# Boucle pour recupérer les rmse des modéles à partir du grid
for (i in 1:num_models) {
# Recupére le modéle i
model <- Note_models[[i]]
# Generate predictions on grade_valid
pred <- predict(object = model,
newdata = Note_valid)
# Compute validation RMSE et l'ajoute
rmse_values[i] <- rmse(actual = Note_valid$final_grade,
predicted = pred)
}
# Identifie le modéle avec le plus petit RMSE
best_model <- Note_models[[which.min(rmse_values)]]
# Affiche les Hyperparamétre du meilleur modéle
best_model$control
# Compute test set RMSE sur best_model
dt_pred <- predict(object = best_model,
newdata = Note_test)
rmse(actual = Note_test$final_grade,
predicted = dt_pred)3
# C'est un phénoméne aléatoire
# On paramétre set seed (123) pour la reproductibilité des mêmes données
set.seed(123)
# Train bagged model
credit_model <- bagging(formula = default ~ .,
data = credit_train,
coob = TRUE) # Pour estimer le Accurracy
# Print model
print(credit_model)
credit_model= rpart(default~.,
data= credit_train,
method = "class")
# prediction utilsant credit_test
class_prediction <- predict(object = credit_model,
newdata =credit_test,
type = "class") # return avec classification
# Print predicted classes
print(class_prediction)
# Calcul le confusion matrix avec les mesure de performance
caret::confusionMatrix( data=class_prediction,
reference= credit_test$default)
# Fait prediction sur credit_test
pred <- predict(object =credit_model,
newdata = credit_test,
type = "prob")
# `pred`
class(pred)
# Look at the pred format
head(pred)
# Compute le AUC (`actual` est binaire et prend 0 ou 1)
bag_auc=auc(actual = ifelse(credit_test$default == "1", 1, 0),
predicted = pred[,"1"])
# Specifier les configuration du training
ctrl <- trainControl(method = "cv", # Cross-validation
number = 5, # 5 folds
classProbs = TRUE, # For AUC (pour considérer les classes)
summaryFunction = twoClassSummary) # For AUC (classification binaire)
# caret est tres sensible au type facteur
credit_train$default= as.character(credit_train$default) %>%
str_replace_all(pattern="1", replacement = "yes")%>%
str_replace_all(pattern = "2", replacement = "no")
credit_test$default= as.character(credit_test$default) %>%
str_replace_all(pattern="1", replacement = "yes")%>%
str_replace_all(pattern = "2", replacement = "no")
# Cross validée le credit model utilisant la method "treebag" ;
# En relatant le AUC (Area under the ROC curve)
set.seed(1) # Pour la reproductibilité
credit_caret_model <-caret::train(default ~.,
data = credit_train,
method = "treebag",
metric = "ROC",
trControl = ctrl)
# Print Model
print(credit_caret_model)
# Inspecter le contenu
names(credit_caret_model)
# Print the CV AUC
credit_caret_model$results[,"ROC"]
# prediction
bg_pred <- predict(object = credit_caret_model,
newdata =credit_test,
type = "prob")
# Compute le AUC (`actual` est binaire et prend 0 ou 1)
auc(actual = ifelse(credit_test$default == "yes", 1, 0),
predicted = bg_pred[,"yes"]) 4
# caret est tres sensible au type facteur
credit_train$default= credit_train$default %>%
as.factor()
credit_test$default= credit_test$default %>%
as.factor()
# Train Random Forest
set.seed(1) # Pour le reproductibilité
credit_model <- randomForest(formula = default ~.,
data = credit_train)
# Print model output
print(credit_model)
# OOB l'erreur moyen dans les predictions Out-of-bag
# Matrice des OOB error
err <- credit_model$err.rate
head(err)
# montre le dernier OOB error
oob_err <- err[nrow(err), "OOB"]
print(oob_err)
# Plot le model (error)
plot(credit_model)
legend(x = "right",
legend = colnames(err),
fill = 1:ncol(err))
# predict train
class_prediction <- predict(object = credit_model, # model
newdata = credit_test, # test dataset
type = "class") # retourne classification
# Calcule le confusion matrix pour le test set
cm <-caret:: confusionMatrix(data = class_prediction, # Classes predites
reference = credit_test$default) # Classe observés
print(cm)
# Compare le test set accuracy au OOB accuracy
paste0("Test Accuracy: ", cm$overall[1])
paste0("OOB Accuracy: ", 1 - oob_err)
# Predict sur credit_test
rf_pred <- predict(object = credit_model,
newdata =credit_test,
type = "prob")
# Compute le AUC (`actual` est binaire et prend 0 ou 1)
auc(actual = ifelse(credit_test$default == "yes", 1, 0),
predicted = rf_pred[,"yes"])
# Execute le tuning process
set.seed(1)
res <- tuneRF(x = subset(credit_train, select = -default),
y =credit_train$default,
ntreeTry = 500) # Nombre max de arbres
# Look at results
print(res)
# trouve le mtry que minimise le OOB error
mtry_opt <- res[,"mtry"][which.min(res[,"OOBError"])]
print(mtry_opt)
# Si on veut juste retrouner le best RF modéle (plus que les resultats)
# set `doBest = TRUE` dans `tuneRF()` Pour retourner le best modéle
# Au lieu de set performance matrix.
mtry <- seq(4, ncol(credit_train) * 0.8, 2) # nombre max de variable à choisir aléatoirement
nodesize <- seq(3, 8, 2) # Nombre de noeud max
sampsize <- nrow(credit_train) * c(0.7, 0.8) # taille du train
# Créer un dataframe avec toute les combinaisons possible
hyper_grid <- expand.grid(mtry = mtry, nodesize = nodesize, sampsize = sampsize)
# Vecteur vide pour stocker les OOB error
oob_err <- c()
# Boucle pour faire un train avec chaque combinaison de paramétre
for (i in 1:nrow(hyper_grid)) {
# Train Random Forest
model <- randomForest(formula = default ~ .,
data = credit_train,
mtry = hyper_grid$mtry[i],
nodesize = hyper_grid$nodesize[i],
sampsize = hyper_grid$sampsize[i])
# Recupére OOB error du model
oob_err[i] <- model$err.rate[nrow(model$err.rate), "OOB"]
}
# Identifie le hyperparamétre optimal en fonction des OOB error
opt_i <- which.min(oob_err)
print(hyper_grid[opt_i,]) 5
# Convertit "yes" to 1, "no" to 0
credit_train$default <- ifelse(credit_train$default == "yes", 1, 0)
credit_test$default<- ifelse(credit_test$default == "yes", 1, 0)
# Train avec 10000-tree
set.seed(1)
credit_model <- gbm(formula = default ~ .,
distribution = "bernoulli", # pour deux class
data = credit_train,
n.trees = 10000)
# Print model
print(credit_model)
# summary() prints l'importance des variable
summary(credit_model)
# Prediction
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = 10000) # Nombre d'arbre à utiliser dans la prediction
# Prediction (avec response)
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees = 10000,
type = "response")
# Compare compare les intervalles de prediction
range(preds1)
range(preds2)
# Generate les AUC
auc(actual = credit_test$default, predicted = preds1) #default
auc(actual = credit_test$default, predicted = preds2) #rescaled
# le ntree optimal pour OOB
ntree_opt_oob <- gbm.perf(object = credit_model,
method = "OOB",
oobag.curve = TRUE)
# Train avec Cross validation GBM model
set.seed(1)
credit_model_cv <- gbm(formula = default ~ .,
distribution = "bernoulli",
data = credit_train,
n.trees = 10000,
cv.folds = 2)
# ntree optimal pour CV
ntree_opt_cv <- gbm.perf(object = credit_model_cv,
method = "cv")
# Compare compare les estimations
print(paste0("Optimal n.trees (OOB Estimate): ", ntree_opt_oob))
print(paste0("Optimal n.trees (CV Estimate): ", ntree_opt_cv))
# prediction sur credit_test apres de ntree_opt_oob nombre de trees
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = ntree_opt_oob)
# prediction sur credit_test apres de ntree_opt_cv nombre de trees
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees =ntree_opt_cv )
# prediction sur credit_test apres de ntree_opt_oob nombre de trees
preds1 <- predict(object = credit_model,
newdata = credit_test,
n.trees = ntree_opt_oob, type="response")
# prediction sur credit_test apres de ntree_opt_cv nombre de trees
preds2 <- predict(object = credit_model,
newdata = credit_test,
n.trees =ntree_opt_cv )
# Generate the test set AUCs using the two sets of preditions & compare
auc1 <- auc(actual = credit_test$default, predicted = preds1) #OOB
auc2 <- auc(actual = credit_test$default, predicted = preds2) #CV
# Compare AUC
print(paste0("Test set AUC (OOB): ", auc1))
print(paste0("Test set AUC (CV): ", auc2))
# List of predictions
preds_list <- list(preds1,preds2)
# List of actual values (same for all)
m <- length(preds_list)
actuals_list <- rep(list(credit_test$default), m)
# Plot the ROC curves
pred <- prediction(preds_list, actuals_list)
rocs <- performance(pred, "tpr", "fpr")
plot(rocs, col = as.list(1:m), main = "Test Set ROC Curves")
legend(x = "bottomright",
legend = c("OOB", "CV"),
fill = 1:m)