# Importation Data
data <- read.table("notes.csv" , sep = "," , header = T)
describe(data$is_genuine) # 70 faux billets , 100 vrais billets soit un ratio de 41.2 % F pour 58.8 % de Vrai
data$is_genuine
n missing distinct
170 0 2
Value 0 1
Frequency 70 100
Proportion 0.412 0.588
70 faux billets , 100 vrais billets. Soit un ratio de 41.2 % Faux pour 58.8 % de Vrai.
# Donnée manquante ?
aggr(data)
describe(data) # Pas de donnée manquante
data
7 Variables 170 Observations
-----------------------------------------------------------------------------------------------------------------------
is_genuine
n missing distinct
170 0 2
Value 0 1
Frequency 70 100
Proportion 0.412 0.588
-----------------------------------------------------------------------------------------------------------------------
diagonal
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 88 1 171.9 0.3422 171.5 171.6 171.7 171.9 172.1 172.3 172.5
lowest : 171.04 171.13 171.35 171.38 171.43, highest: 172.53 172.57 172.59 172.75 173.01
-----------------------------------------------------------------------------------------------------------------------
height_left
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 91 1 104.1 0.3411 103.6 103.7 103.8 104.1 104.3 104.5 104.6
lowest : 103.23 103.47 103.49 103.51 103.52, highest: 104.60 104.61 104.65 104.72 104.86
-----------------------------------------------------------------------------------------------------------------------
height_right
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 96 1 103.9 0.3749 103.4 103.5 103.7 104.0 104.2 104.3 104.4
lowest : 103.14 103.25 103.29 103.31 103.34, highest: 104.50 104.64 104.83 104.86 104.95
-----------------------------------------------------------------------------------------------------------------------
margin_low
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 123 1 4.612 0.7939 3.715 3.810 4.050 4.450 5.128 5.712 5.891
lowest : 3.54 3.60 3.64 3.65 3.66, highest: 6.00 6.01 6.16 6.19 6.28
-----------------------------------------------------------------------------------------------------------------------
margin_up
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 81 1 3.17 0.2655 2.800 2.890 3.012 3.170 3.330 3.470 3.591
lowest : 2.27 2.56 2.70 2.71 2.75, highest: 3.63 3.65 3.66 3.67 3.68
-----------------------------------------------------------------------------------------------------------------------
length
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
170 0 129 1 112.6 1.038 110.8 111.3 111.9 112.8 113.3 113.6 113.7
lowest : 109.97 110.31 110.48 110.53 110.61, highest: 113.83 113.84 113.87 113.92 113.98
-----------------------------------------------------------------------------------------------------------------------
## Univarié : Histogramme des variables
plot_num(data)
billet.var.dim = c('length', 'height_left', 'height_right', 'margin_low', 'margin_up', 'diagonal')
par(mfrow=c(2,3))
for (var in billet.var.dim) {
boxplot(
data[data$is_genuine == 'True', var],
data[data$is_genuine == 'False', var],
col = c('#00B233', '#B20000'),
horizontal = TRUE
)
title(main=var)
}
Lecture des Boxplots :
p4 <- ggplot(data) +
aes(x= diagonal , fill = is_genuine) +
geom_density(position = "identity" , alpha = 0.5 , bins = 100) +
labs(x = "",
y = "",
title = "Histogramme diagonal", subtitle = "") +
labs(fill = "") +
theme(legend.position = "top")
# Diagonal n'est pas un bonne indicateur pour vérifier l'authenticité d'un billet , la longueur est en revanche très pertinante.
p1 <- ggplot(data) +
aes(x = length , y = diagonal , color = is_genuine) +
geom_point() +
ggtitle("longueur vs diagonale", subtitle = "")
# Plus les variables margin_low et margin_up sont élévées plus les billets sont faux
p2 <- ggplot(data) +
aes(x = margin_low , y = margin_up , color = is_genuine) +
geom_point() +
ggtitle("margin_up vs margin_low", subtitle = "")
# Marge gauche et droite
p3 <- ggplot(data) +
aes(x = height_right, y = height_left , color = is_genuine) +
geom_point() +
ggtitle("height_left vs heigth_right", subtitle = "")
grid.arrange(p1,p2,p3,p4)
## Corrélation ---------
# matrice Pearson
vis_cor(data= select(data,-is_genuine))
NA
NA
res.PCA<-PCA(data,quali.sup=c(1),graph=FALSE)
plot.PCA(res.PCA,choix='var',select='cos2 0.05',unselect=0,title="Graphe des variables de l'ACP",col.var='#643982')
plot.PCA(res.PCA,invisible=c('ind.sup'),title="Graphe des individus de l'ACP",cex=0.75,cex.main=0.75,cex.axis=0.75,col.ind='#B5A8A8',label =c('ind','quali'))
fviz_eig(res.PCA, addlabels = TRUE, ylim = c(0, 50)) # 83.9 % de variance sur 3 prèmieres dimensions
NA
NA
NA
# COS 2
var <- get_pca_var(res.PCA)
corrplot(var$cos2)
ggcorrplot(var$cos2,lab = T)
# Dimension 1 : toutes les variables sauf diagnonal
# Dimension 2 : diagonal
# dimension 3 : margin_up
# Qualité de la représentation Cos2
fviz_pca_var(res.PCA, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE
)
# Contribution
corrplot(var$contrib, is.corr=FALSE)
fviz_pca_var(res.PCA, col.var = "contrib", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))
NA
NA
NA
NA
NA
3 points sur l’ACP
La longueur est positivement corrélée à l’authenticité d’un billet.
Les variables height_left, height_right, margin_up,margin_low sont négativements corrélées à l’authenticité d’un billet.
Diagonal : plus compliqué de conclure.
fig = fviz_pca_ind(res.PCA,
axes = c(1,2),
geom=c('point'),
habillage = 1,
palette = c('#B20000','#00B233'),
alpha.ind="cos2",
select.ind = list(cos2 = 0.3),
mean.point = FALSE,
addEllipses = TRUE,
pointshape=19,
legend.title = "Type de billet"
)
fig
# Nombre de cluster ? Vrai ou faux k= 2
fviz_nbclust(select(data,-is_genuine), kmeans,k.max = 10, method = "silhouette")
fviz_nbclust(select(data,-is_genuine), kmeans,k.max = 10, method = "gap_stat")
Clustering k = 1,2,..., K.max (= 10): .. done
Bootstrapping, b = 1,2,..., B (= 100) [one "." per sample]:
.................................................. 50
.................................................. 100
k <- kmeans(scale(data[, -1]), 2, nstart = 25)
k
K-means clustering with 2 clusters of sizes 77, 93
Cluster means:
diagonal height_left height_right margin_low margin_up length
1 -0.06393490 0.6446278 0.7186422 0.8134553 0.6405718 -0.8752392
2 0.05293535 -0.5337241 -0.5950049 -0.6735060 -0.5303659 0.7246604
Clustering vector:
[1] 1 2 2 2 2 1 2 2 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[58] 2 2 2 2 2 2 2 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[115] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
Within cluster sum of squares by cluster:
[1] 312.2003 311.3286
(between_SS / total_SS = 38.5 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss" "betweenss" "size"
[8] "iter" "ifault"
fviz_cluster(k, data = data[, -1],
palette = c("#2E9FDF", "#00AFBB", "#E7B800"),
geom = "point",
ellipse.type = "convex",
ggtheme = theme_bw()
)
data_k <- mutate(data, cluster =k[["cluster"]]) # On créer un dataframe où l'on ajoute les clusters du kmeans
Ktab <- table(data_k$is_genuine,data_k$cluster) # On calcul un tableau croisé , pour voir les vrai /faux positifs ......V/F négatif
Ktab # Tableau
1 2
False 69 1
True 8 92
cprop(Ktab) # On exprime ce tableau en terme de pourcentage
1 2 Ensemble
False 89.6 1.1 41.2
True 10.4 98.9 58.8
Total 100.0 100.0 100.0
Probabilité d’avoir un billet vrai à tort 10.4% (pensant qu’il est faux)
On a 1.1 % d’avoir un billet Faux pensant qu’il est Vrai
Modèle de Kmeans à deux dimensions est assez fiable dans la détection de faux billets : 89.6 % de détection de faux billets à raison.
res.HCPC1<-HCPC(res.PCA,nb.clust=2,consol=FALSE,graph=FALSE)
data_HCPC1 <- mutate(data, cluster = res.HCPC1[["data.clust"]][["clust"]])
Htab <- table(data_HCPC1$is_genuine,data_HCPC1$cluster)
Htab
1 2
False 1 69
True 98 2
cprop(Htab) # Meilleur modèle que le Kmeans , On passe de 89.6 % à 97.2 % de détection de faux billet à raison.
1 2 Ensemble
False 1.0 97.2 41.2
True 99.0 2.8 58.8
Total 100.0 100.0 100.0
Meilleur modèle que le K means (sans réduction de dimension) , On passe de 89.6 % à 97.2 % de détection de faux billet à raison.
res.PCA2<-PCA(data,ncp=3,quali.sup=c(1),graph=FALSE)
res.HCPC<-HCPC(res.PCA2,nb.clust=2,kk=100,consol=FALSE,graph=FALSE)
plot.HCPC(res.HCPC,choice='tree',title='Arbre hiérarchique')
plot.HCPC(res.HCPC,choice='map',draw.tree=FALSE,title='Plan factoriel')
data_HCPC <- mutate(data, cluster = res.HCPC[["data.clust"]][["clust"]])
HCPCtab <- table(data_HCPC$is_genuine,data_HCPC$cluster)
HCPCtab
1 2
False 4 66
True 76 24
cprop(HCPCtab) # Modèle nettement moins performant pour la détection de faux billets .
1 2 Ensemble
False 5.0 73.3 41.2
True 95.0 26.7 58.8
Total 100.0 100.0 100.0
fviz_cluster(res.HCPC,
repel = TRUE,
show.clust.cent = TRUE,
palette = "jco",
ggtheme = theme_minimal(),
main = "Factor map"
)
Modèle nettement moins performant pour la détection de faux billets
# SANS Reduction des dimensions PCA Kmean + HCPC
res.HCPC2<-HCPC(res.PCA,nb.clust=2,kk=100,consol=FALSE,graph=FALSE)
data_HCPC2 <- mutate(data, cluster = res.HCPC2[["data.clust"]][["clust"]])
table(data_HCPC2$is_genuine,data_HCPC2$cluster)
1 2
False 0 70
True 98 2
cprop(table(data_HCPC2$is_genuine,data_HCPC2$cluster))
1 2 Ensemble
False 0.0 97.2 41.2
True 100.0 2.8 58.8
Total 100.0 100.0 100.0
# Même résultat que HCPC sans Kmeans , c'est pour l'instant notre meilleur modèle .
Quasiment le même résultat que HCPC sans K-Means. C’est un meilleur modèle pour la détection de faux billets. Une meilleure détection des vrais billets est aussi à constater.
## Recodage de data$is_genuine
data$is_genuine <- fct_recode(data$is_genuine,
"0" = "False",
"1" = "True"
)
# Partition
set.seed(100)
trainIndex <- createDataPartition(data$is_genuine,p=0.7,list=F)
print(length(trainIndex))
[1] 119
print(head(trainIndex,10))
Resample1
[1,] 2
[2,] 3
[3,] 5
[4,] 6
[5,] 8
[6,] 9
[7,] 11
[8,] 12
[9,] 14
[10,] 15
#data frame pour les individus en apprentissage
Train <- data[trainIndex,]
print(dim(Train))
[1] 119 7
#data frame pour les individus en test
Test <- data[-trainIndex,]
print(dim(Test))
[1] 51 7
#fréquences absolues des classes - éch. d'apprentissage
print(table(Train$is_genuine))
0 1
49 70
#fréquences relatives des classes dans l'éch. d'apprentissage
print(prop.table(table(Train$is_genuine)))
0 1
0.4117647 0.5882353
print(prop.table(table(data$is_genuine))) # Même répartition entre df original et échantillon d'apprentissage
0 1
0.4117647 0.5882353
# Modélisation Régression Logistique
#paramètre du processu d'apprentissage
fitControl <- trainControl(method="none")
# apprentissage - régression logistique
m_lr <- train(is_genuine ~ ., data = Train,method="glm",trControl=fitControl)
#coefficients de la régression logistique
print(m_lr$finalModel)
Call: NULL
Coefficients:
(Intercept) diagonal height_left height_right margin_low margin_up length
1190.50 -16.50 -68.96 36.56 -79.59 -56.05 49.66
Degrees of Freedom: 118 Total (i.e. Null); 112 Residual
Null Deviance: 161.2
Residual Deviance: 8.021e-09 AIC: 14
#prediction
pred <- predict(m_lr,newdata=Test)
print(table(pred)) # 40 % / 60 % ok !
pred
0 1
20 31
#matrice de confusion
mat <- confusionMatrix(data=pred,reference=Test$is_genuine)
print(mat)
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 20 0
1 1 30
Accuracy : 0.9804
95% CI : (0.8955, 0.9995)
No Information Rate : 0.5882
P-Value [Acc > NIR] : 6.483e-11
Kappa : 0.9592
Mcnemar's Test P-Value : 1
Sensitivity : 0.9524
Specificity : 1.0000
Pos Pred Value : 1.0000
Neg Pred Value : 0.9677
Prevalence : 0.4118
Detection Rate : 0.3922
Detection Prevalence : 0.3922
Balanced Accuracy : 0.9762
'Positive' Class : 0
Indicateurs globaux
#accès aux indicateurs globaux
print(mat$overall)
Accuracy Kappa AccuracyLower AccuracyUpper AccuracyNull AccuracyPValue McnemarPValue
9.803922e-01 9.592326e-01 8.955251e-01 9.995037e-01 5.882353e-01 6.482926e-11 1.000000e+00
### Courbe Lift ------
#score des individus positifs
score <- predict(m_lr,Test,type="prob")[,"1"]
#tableau de données pour le scoring
liftdata <- data.frame(classe=Test$is_genuine)
liftdata$score <- score
#objet lift
lift_obj <- lift(classe ~ score, data=liftdata, class="1")
#affichage de la courbe lift
plot(lift_obj)
NA
NA
### Courbe ROC et AUC ------
library(pROC)
Type 'citation("pROC")' for a citation.
Attachement du package : ‘pROC’
L'objet suivant est masqué depuis ‘package:colorspace’:
coords
Les objets suivants sont masqués depuis ‘package:stats’:
cov, smooth, var
#objet roc
roc_obj <- roc(Test$is_genuine=="1",score)
Setting levels: control = FALSE, case = TRUE
Setting direction: controls < cases
#plot de l'objet roc
plot(1-roc_obj$specificities,roc_obj$sensitivities,type="l")
abline(0,1)
# AUC
print(roc_obj$auc) # Area under the curve: 0.9984
Area under the curve: 0.9984
Nous avons modèle avec de bons indicateurs de fiabilités, cependant les données sont peu nombreuses.
Nous allons tester une autre méthode plus adaptée à nos données.
La validation croisée stratifiée.
fitControl <- trainControl(method="cv",number=10)
m_lr <- train(is_genuine ~ ., data = Train,method="glm",trControl=fitControl)
print(m_lr)
Generalized Linear Model
119 samples
6 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 107, 107, 107, 107, 107, 108, ...
Resampling results:
Accuracy Kappa
0.9833333 0.9666667
print(varImp(m_lr))
glm variable importance
print(m_lr$resample)
NA
#méthode intégrée de sélection
m_lrs <- train(is_genuine ~ ., data = Train, method="glmStepAIC",
trControl=trainControl("none"))
Start: AIC=14
.outcome ~ diagonal + height_left + height_right + margin_low +
margin_up + length
Df Deviance AIC
- diagonal 1 0.0000 12.000
- height_right 1 0.0000 12.000
- height_left 1 0.0000 12.000
- margin_up 1 0.0000 12.000
<none> 0.0000 14.000
- length 1 9.8426 21.843
- margin_low 1 15.8238 27.824
Step: AIC=12
.outcome ~ height_left + height_right + margin_low + margin_up +
length
Df Deviance AIC
- height_right 1 0.0000 10.000
- height_left 1 0.0000 10.000
- margin_up 1 0.0000 10.000
<none> 0.0000 12.000
- length 1 9.9169 19.917
- margin_low 1 22.9056 32.906
Step: AIC=10
.outcome ~ height_left + margin_low + margin_up + length
Df Deviance AIC
- margin_up 1 0.0000 8.000
- height_left 1 0.0000 8.000
<none> 0.0000 10.000
- length 1 9.9325 17.932
- margin_low 1 27.1771 35.177
Step: AIC=8
.outcome ~ height_left + margin_low + length
Df Deviance AIC
- height_left 1 0.000 6.000
<none> 0.000 8.000
- margin_low 1 29.697 35.697
- length 1 52.901 58.901
Step: AIC=6
.outcome ~ margin_low + length
Df Deviance AIC
<none> 0.000 6.000
- margin_low 1 36.289 40.289
- length 1 61.253 65.253
print(m_lrs$finalModel)
Call: NULL
Coefficients:
(Intercept) margin_low length
-11588.5 -182.5 110.5
Degrees of Freedom: 118 Total (i.e. Null); 116 Residual
Null Deviance: 161.2
Residual Deviance: 2.663e-08 AIC: 6
On teste
# application sur le test set - mesure des performances
print(confusionMatrix(data=predict(m_lrs,newdata =
Test),reference=Test$is_genuine))
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 20 1
1 1 29
Accuracy : 0.9608
95% CI : (0.8654, 0.9952)
No Information Rate : 0.5882
P-Value [Acc > NIR] : 1.168e-09
Kappa : 0.919
Mcnemar's Test P-Value : 1
Sensitivity : 0.9524
Specificity : 0.9667
Pos Pred Value : 0.9524
Neg Pred Value : 0.9667
Prevalence : 0.4118
Detection Rate : 0.3922
Detection Prevalence : 0.4118
Balanced Accuracy : 0.9595
'Positive' Class : 0
Performance légèrement moins bonne que le modèle “Train and Test”. Cependant ce résultat est attendu. La stratification croisée donne généralement un modèle plus fiable pour les petits jeux de données.
billets.test = read.table("test_notes.csv", sep=',', dec = '.', header = T)
rownames(billets.test) = billets.test$id
#billets.test <- billets.test %>% select(-id)
# caclul des probabilités
billet.test.prob.vrai = predict(m_lrs, newdata = billets.test[,billet.var.dim],
type="prob")
billet.test.prob.faux = 1 - billet.test.prob.vrai
billet_t <- cbind(billet.test.prob.vrai,billets.test$id)
for (i in 1:length(billet.test.prob.vrai$`1`)) {
cat('- Billet',i, '\t P(VRAI) = ', billet.test.prob.vrai$`1`[i], '\n')
if (billet.test.prob.vrai$`1`[i] < 0.5) {
cat("\t\t --> FAUX BILLET\n\n")
} else {
cat("\t\t --> VRAI BILLET\n\n")
}
}
- Billet 1 P(VRAI) = 1
--> VRAI BILLET
- Billet 2 P(VRAI) = 2.220446e-16
--> FAUX BILLET
- Billet 3 P(VRAI) = 1
--> VRAI BILLET
- Billet 4 P(VRAI) = 2.220446e-16
--> FAUX BILLET
- Billet 5 P(VRAI) = 2.220446e-16
--> FAUX BILLET
Vérifions notre programme à l’aide d’un fichier réponse.
read.table("test_notes_with_labels.csv", header = T, sep=',')
On trouve le même résultat, à savoir :
On cherche les meilleurs paramètres du modèle
### Hyper Paramètre C -------
#paramètres d'apprentissage
fitControl <- trainControl(method="cv",number=5)
#modélisation avec paramètre de la technique d'apprentissage
#SVM avec noyau linéaire, C = 0.1
m_svm <- train(is_genuine ~ ., data = Train,method="svmLinear",trControl=fitControl,tuneGrid=data.frame(C=0.1))
print(m_svm)
Support Vector Machines with Linear Kernel
119 samples
6 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 95, 95, 96, 95, 95
Resampling results:
Accuracy Kappa
0.9913043 0.9821012
Tuning parameter 'C' was held constant at a value of 0.1
m_svmg <- train(is_genuine ~ ., data = Train,method="svmLinear",trControl=fitControl,tuneGrid=data.frame(C=c(0.05,0.1,0.5,1,10)))
print(m_svmg)
Support Vector Machines with Linear Kernel
119 samples
6 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 95, 96, 95, 95, 95
Resampling results across tuning parameters:
C Accuracy Kappa
0.05 0.9916667 0.9830986
0.10 0.9916667 0.9830986
0.50 0.9916667 0.9830986
1.00 0.9916667 0.9830986
10.00 0.9833333 0.9661972
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was C = 0.05.
On teste notre modèle SVM
print(confusionMatrix(data=predict(m_svmg,newdata =
Test),reference=Test$is_genuine,positive="1"))
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 21 0
1 0 30
Accuracy : 1
95% CI : (0.9302, 1)
No Information Rate : 0.5882
P-Value [Acc > NIR] : 1.766e-12
Kappa : 1
Mcnemar's Test P-Value : NA
Sensitivity : 1.0000
Specificity : 1.0000
Pos Pred Value : 1.0000
Neg Pred Value : 1.0000
Prevalence : 0.5882
Detection Rate : 0.5882
Detection Prevalence : 0.5882
Balanced Accuracy : 1.0000
'Positive' Class : 1
100 % de bonne réponse !
L’algorithme SVM a de meilleures performances.