# Importation Data 

data <- read.table("notes.csv" , sep = "," , header = T)

Mission 0

Statistiques descriptives

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ées manquantes ?

# 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
-----------------------------------------------------------------------------------------------------------------------

Histogrammes des variables

## Univarié : Histogramme des variables 

plot_num(data)

Analyse bivariée : Boxplot des variables en fonction l’authenticité des billets

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 :

  1. La variable length (et diagonal?) sont corrélées positivement aux vrais billets.
  2. Les autres variables sont corrélées négativements aux vrais billets ( soit corrélées positivement aux faux billets).
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

Mission 1 : ACP exploratoire

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

  1. La longueur est positivement corrélée à l’authenticité d’un billet.

  2. Les variables height_left, height_right, margin_up,margin_low sont négativements corrélées à l’authenticité d’un billet.

  3. 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

Mission 2 : Classification non supervisée

K means

Nombre optimal de cluster

# 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.

HCPC

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.

Réduction par ACP HCPC + K means

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

HCPC + K means , sans réduction de dimension

# 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.

Mission 3 : Régression logistique

Méthode 1 Train and Test

Partition


## 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

Train and Test

#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 de la régression logistique

# 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

#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

### 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

### 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.

méthode 2 évaluation par rééchantillonnage

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é de sélection , Stepwise par AIC

#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.

Programme de détection de faux billets

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 :

  • Billet 1 : Vrai
  • Billet 2 : Faux
  • Billet 3 : Vrai
  • Billet 4 : Faux
  • Billet 5 : Faux

Pour aller plus loin , l’algorithme SVM : support-vector machine

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.

LS0tDQp0aXRsZTogIlByb2pldCA2IDogRMOpdGVjdGlvbiBkZSBmYXV4IGJpbGxldHMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQoNCg0KYGBge3J9DQojIEltcG9ydGF0aW9uIERhdGEgDQoNCmRhdGEgPC0gcmVhZC50YWJsZSgibm90ZXMuY3N2IiAsIHNlcCA9ICIsIiAsIGhlYWRlciA9IFQpDQpgYGANCg0KYGBge3IgaW5jbHVkZT1GQUxTRX0NCiMgUGFja2FnZSANCg0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KFZJTSkNCmxpYnJhcnkocXVlc3Rpb25yKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoRmFjdG9NaW5lUikNCmxpYnJhcnkodmlzZGF0KQ0KbGlicmFyeShmYWN0b2V4dHJhKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShjb3JycGxvdCkNCmxpYnJhcnkoZ2djb3JycGxvdCkNCmxpYnJhcnkoZ3JpZEV4dHJhKQ0KbGlicmFyeShjbHVzdGVyKQ0KbGlicmFyeShOYkNsdXN0KQ0KbGlicmFyeShNQVNTKQ0KbGlicmFyeShHR2FsbHkpDQpsaWJyYXJ5KGNhcikNCmxpYnJhcnkoY2FyZXQpDQojbGlicmFyeShndHN1bW1hcnkpDQpsaWJyYXJ5KGZ1bk1vZGVsaW5nKQ0KYGBgDQoNCiMgTWlzc2lvbiAwDQoNCiMjIFN0YXRpc3RpcXVlcyBkZXNjcmlwdGl2ZXMNCg0KYGBge3IgZGVzY3JpYmUgfQ0KZGVzY3JpYmUoZGF0YSRpc19nZW51aW5lKSAjIDcwIGZhdXggYmlsbGV0cyAsIDEwMCB2cmFpcyBiaWxsZXRzIHNvaXQgdW4gcmF0aW8gZGUgNDEuMiAlIEYgIHBvdXIgNTguOCAlIGRlIFZyYWkgDQpgYGANCjcwIGZhdXggYmlsbGV0cyAsIDEwMCB2cmFpcyBiaWxsZXRzLg0KU29pdCB1biByYXRpbyBkZSA0MS4yICUgRmF1eCAgcG91ciA1OC44ICUgZGUgVnJhaS4NCg0KIyMjIERvbm7DqWVzIG1hbnF1YW50ZXMgPyANCg0KYGBge3IgTkF9DQojIERvbm7DqWUgbWFucXVhbnRlID8NCg0KYWdncihkYXRhKQ0KZGVzY3JpYmUoZGF0YSkgICMgUGFzIGRlIGRvbm7DqWUgbWFucXVhbnRlIA0KYGBgDQojIyMgSGlzdG9ncmFtbWVzIGRlcyB2YXJpYWJsZXMNCmBgYHtyIEhpc3RvZ3JhbSwgd2FybmluZz1GQUxTRX0NCiMjIFVuaXZhcmnDqSA6IEhpc3RvZ3JhbW1lIGRlcyB2YXJpYWJsZXMgDQoNCnBsb3RfbnVtKGRhdGEpDQoNCmBgYA0KIyMjIEFuYWx5c2UgYml2YXJpw6llIDogQm94cGxvdCBkZXMgdmFyaWFibGVzIGVuIGZvbmN0aW9uIGwnYXV0aGVudGljaXTDqSBkZXMgYmlsbGV0cw0KYGBge3IgQm94cGxvdH0NCmJpbGxldC52YXIuZGltID0gYygnbGVuZ3RoJywgJ2hlaWdodF9sZWZ0JywgJ2hlaWdodF9yaWdodCcsICdtYXJnaW5fbG93JywgJ21hcmdpbl91cCcsICdkaWFnb25hbCcpDQoNCnBhcihtZnJvdz1jKDIsMykpDQpmb3IgKHZhciBpbiBiaWxsZXQudmFyLmRpbSkgew0KICBib3hwbG90KA0KICAgIGRhdGFbZGF0YSRpc19nZW51aW5lID09ICdUcnVlJywgdmFyXSwNCiAgICBkYXRhW2RhdGEkaXNfZ2VudWluZSA9PSAnRmFsc2UnLCB2YXJdLA0KICAgIGNvbCA9IGMoJyMwMEIyMzMnLCAnI0IyMDAwMCcpLA0KICAgIGhvcml6b250YWwgPSBUUlVFDQogICkNCiAgdGl0bGUobWFpbj12YXIpIA0KICB9DQpgYGANCkxlY3R1cmUgZGVzIEJveHBsb3RzIDogDQoNCjEuIExhIHZhcmlhYmxlIGxlbmd0aCAoZXQgZGlhZ29uYWw/KSAgc29udCBjb3Jyw6lsw6llcyBwb3NpdGl2ZW1lbnQgYXV4IHZyYWlzIGJpbGxldHMuDQoyLiBMZXMgYXV0cmVzIHZhcmlhYmxlcyBzb250IGNvcnLDqWzDqWVzIG7DqWdhdGl2ZW1lbnRzIGF1eCB2cmFpcyBiaWxsZXRzICggc29pdCBjb3Jyw6lsw6llcyBwb3NpdGl2ZW1lbnQgYXV4IGZhdXggYmlsbGV0cykuDQoNCmBgYHtyIGdlb20gcG9pbnQsIHdhcm5pbmc9RkFMU0V9DQpwNCA8LSBnZ3Bsb3QoZGF0YSkgKw0KICBhZXMoeD0gZGlhZ29uYWwgLCBmaWxsID0gaXNfZ2VudWluZSkgKw0KICBnZW9tX2RlbnNpdHkocG9zaXRpb24gPSAiaWRlbnRpdHkiICwgYWxwaGEgPSAwLjUgLCBiaW5zID0gMTAwKSArDQogIGxhYnMoeCA9ICIiLA0KICAgICAgIHkgPSAiIiwNCiAgICAgICB0aXRsZSA9ICJIaXN0b2dyYW1tZSBkaWFnb25hbCIsIHN1YnRpdGxlID0gIiIpICsNCiAgbGFicyhmaWxsID0gIiIpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInRvcCIpIA0KDQoNCiMgRGlhZ29uYWwgbidlc3QgcGFzIHVuIGJvbm5lIGluZGljYXRldXIgcG91ciB2w6lyaWZpZXIgbCdhdXRoZW50aWNpdMOpIGQndW4gYmlsbGV0ICwgbGEgbG9uZ3VldXIgZXN0IGVuIHJldmFuY2hlIHRyw6hzIHBlcnRpbmFudGUuDQoNCnAxIDwtIGdncGxvdChkYXRhKSArDQogIGFlcyh4ID0gbGVuZ3RoICwgeSA9IGRpYWdvbmFsICwgY29sb3IgPSBpc19nZW51aW5lKSArIA0KICBnZW9tX3BvaW50KCkgKw0KICBnZ3RpdGxlKCJsb25ndWV1ciB2cyBkaWFnb25hbGUiLCBzdWJ0aXRsZSA9ICIiKQ0KDQoNCiMgUGx1cyBsZXMgdmFyaWFibGVzIG1hcmdpbl9sb3cgZXQgbWFyZ2luX3VwIHNvbnQgw6lsw6l2w6llcyBwbHVzIGxlcyBiaWxsZXRzIHNvbnQgZmF1eCANCg0KcDIgPC0gZ2dwbG90KGRhdGEpICsNCiAgYWVzKHggPSBtYXJnaW5fbG93ICwgeSA9IG1hcmdpbl91cCAsIGNvbG9yID0gaXNfZ2VudWluZSkgKyANCiAgZ2VvbV9wb2ludCgpICsNCiAgZ2d0aXRsZSgibWFyZ2luX3VwIHZzIG1hcmdpbl9sb3ciLCBzdWJ0aXRsZSA9ICIiKSANCg0KDQoNCiMgTWFyZ2UgZ2F1Y2hlIGV0IGRyb2l0ZSANCg0KcDMgPC0gZ2dwbG90KGRhdGEpICsNCiAgYWVzKHggPSBoZWlnaHRfcmlnaHQsIHkgPSBoZWlnaHRfbGVmdCAsIGNvbG9yID0gaXNfZ2VudWluZSkgKyANCiAgZ2VvbV9wb2ludCgpICsNCiAgZ2d0aXRsZSgiaGVpZ2h0X2xlZnQgdnMgaGVpZ3RoX3JpZ2h0Iiwgc3VidGl0bGUgPSAiIikNCg0KZ3JpZC5hcnJhbmdlKHAxLHAyLHAzLHA0KQ0KYGBgDQoNCmBgYHtyIGNvcnLDqWxhdGlvbiBtYXRyaWNlfQ0KIyMgQ29ycsOpbGF0aW9uIC0tLS0tLS0tLSANCg0KIyBtYXRyaWNlIFBlYXJzb24gDQp2aXNfY29yKGRhdGE9IHNlbGVjdChkYXRhLC1pc19nZW51aW5lKSkNCg0KDQpgYGANCg0KIyBNaXNzaW9uIDEgOiBBQ1AgZXhwbG9yYXRvaXJlDQoNCmBgYHtyIFBDQSBleHBsb3JhdG9pcmV9DQpyZXMuUENBPC1QQ0EoZGF0YSxxdWFsaS5zdXA9YygxKSxncmFwaD1GQUxTRSkNCg0KcGxvdC5QQ0EocmVzLlBDQSxjaG9peD0ndmFyJyxzZWxlY3Q9J2NvczIgIDAuMDUnLHVuc2VsZWN0PTAsdGl0bGU9IkdyYXBoZSBkZXMgdmFyaWFibGVzIGRlIGwnQUNQIixjb2wudmFyPScjNjQzOTgyJykNCnBsb3QuUENBKHJlcy5QQ0EsaW52aXNpYmxlPWMoJ2luZC5zdXAnKSx0aXRsZT0iR3JhcGhlIGRlcyBpbmRpdmlkdXMgZGUgbCdBQ1AiLGNleD0wLjc1LGNleC5tYWluPTAuNzUsY2V4LmF4aXM9MC43NSxjb2wuaW5kPScjQjVBOEE4JyxsYWJlbCA9YygnaW5kJywncXVhbGknKSkNCg0KZnZpel9laWcocmVzLlBDQSwgYWRkbGFiZWxzID0gVFJVRSwgeWxpbSA9IGMoMCwgNTApKSAjIDgzLjkgJSBkZSB2YXJpYW5jZSAgc3VyIDMgcHLDqG1pZXJlcyBkaW1lbnNpb25zDQoNCg0KDQpgYGANCg0KYGBge3IgQ29zIDJ9DQojIENPUyAyDQoNCnZhciA8LSBnZXRfcGNhX3ZhcihyZXMuUENBKQ0KY29ycnBsb3QodmFyJGNvczIpDQpnZ2NvcnJwbG90KHZhciRjb3MyLGxhYiA9IFQpDQoNCiMgRGltZW5zaW9uIDEgOiB0b3V0ZXMgbGVzIHZhcmlhYmxlcyBzYXVmIGRpYWdub25hbA0KIyBEaW1lbnNpb24gMiA6IGRpYWdvbmFsIA0KIyBkaW1lbnNpb24gMyA6IG1hcmdpbl91cA0KDQojIFF1YWxpdMOpIGRlIGxhIHJlcHLDqXNlbnRhdGlvbiBDb3MyDQoNCmZ2aXpfcGNhX3ZhcihyZXMuUENBLCBjb2wudmFyID0gImNvczIiLA0KICAgICAgICAgICAgIGdyYWRpZW50LmNvbHMgPSBjKCIjMDBBRkJCIiwgIiNFN0I4MDAiLCAiI0ZDNEUwNyIpLA0KICAgICAgICAgICAgIHJlcGVsID0gVFJVRSANCikNCg0KYGBgDQoNCmBgYHtyfQ0KIyBDb250cmlidXRpb24gDQoNCmNvcnJwbG90KHZhciRjb250cmliLCBpcy5jb3JyPUZBTFNFKQ0KDQpmdml6X3BjYV92YXIocmVzLlBDQSwgY29sLnZhciA9ICJjb250cmliIiwgZ3JhZGllbnQuY29scyA9IGMoIiMwMEFGQkIiLCAiI0U3QjgwMCIsICIjRkM0RTA3IikpDQoNCg0KDQoNCg0KYGBgDQoNCjMgcG9pbnRzIHN1ciBsJ0FDUA0KDQoxLiAgTGEgbG9uZ3VldXIgZXN0IHBvc2l0aXZlbWVudCBjb3Jyw6lsw6llIMOgIGwnYXV0aGVudGljaXTDqSBkJ3VuIGJpbGxldC4NCg0KMi4gIExlcyB2YXJpYWJsZXMgaGVpZ2h0X2xlZnQsIGhlaWdodF9yaWdodCwgbWFyZ2luX3VwLG1hcmdpbl9sb3cgc29udCBuw6lnYXRpdmVtZW50cyBjb3Jyw6lsw6llcyDDoCBsJ2F1dGhlbnRpY2l0w6kgZCd1biBiaWxsZXQuDQoNCjMuICBEaWFnb25hbCA6IHBsdXMgY29tcGxpcXXDqSBkZSBjb25jbHVyZS4NCg0KYGBge3J9DQpmaWcgPSBmdml6X3BjYV9pbmQocmVzLlBDQSwgDQogICAgICAgICAgICAgICAgICAgYXhlcyA9IGMoMSwyKSwNCiAgICAgICAgICAgICAgICAgICBnZW9tPWMoJ3BvaW50JyksDQogICAgICAgICAgICAgICAgICAgaGFiaWxsYWdlID0gMSwNCiAgICAgICAgICAgICAgICAgICBwYWxldHRlID0gYygnI0IyMDAwMCcsJyMwMEIyMzMnKSwNCiAgICAgICAgICAgICAgICAgICBhbHBoYS5pbmQ9ImNvczIiLA0KICAgICAgICAgICAgICAgICAgIHNlbGVjdC5pbmQgPSBsaXN0KGNvczIgPSAwLjMpLA0KICAgICAgICAgICAgICAgICAgIG1lYW4ucG9pbnQgPSBGQUxTRSwNCiAgICAgICAgICAgICAgICAgICBhZGRFbGxpcHNlcyA9IFRSVUUsDQogICAgICAgICAgICAgICAgICAgcG9pbnRzaGFwZT0xOSwNCiAgICAgICAgICAgICAgICAgICBsZWdlbmQudGl0bGUgPSAiVHlwZSBkZSBiaWxsZXQiDQopDQoNCmZpZw0KYGBgDQoNCg0KDQoNCiMgTWlzc2lvbiAyIDogIENsYXNzaWZpY2F0aW9uIG5vbiBzdXBlcnZpc8OpZSANCg0KIyMgSyBtZWFucyANCg0KIyMjIE5vbWJyZSBvcHRpbWFsIGRlIGNsdXN0ZXIgDQpgYGB7ciwgd2FybmluZz1GQUxTRX0NCiMgTm9tYnJlIGRlIGNsdXN0ZXIgPyBWcmFpIG91IGZhdXggaz0gMg0KDQpmdml6X25iY2x1c3Qoc2VsZWN0KGRhdGEsLWlzX2dlbnVpbmUpLCBrbWVhbnMsay5tYXggPSAxMCwgbWV0aG9kID0gInNpbGhvdWV0dGUiKQ0KDQpmdml6X25iY2x1c3Qoc2VsZWN0KGRhdGEsLWlzX2dlbnVpbmUpLCBrbWVhbnMsay5tYXggPSAxMCwgbWV0aG9kID0gImdhcF9zdGF0IikNCg0KYGBgDQpgYGB7cn0NCmsgPC0ga21lYW5zKHNjYWxlKGRhdGFbLCAtMV0pLCAyLCBuc3RhcnQgPSAyNSkNCmsNCg0KZnZpel9jbHVzdGVyKGssIGRhdGEgPSBkYXRhWywgLTFdLA0KICAgICAgICAgICAgIHBhbGV0dGUgPSBjKCIjMkU5RkRGIiwgIiMwMEFGQkIiLCAiI0U3QjgwMCIpLCANCiAgICAgICAgICAgICBnZW9tID0gInBvaW50IiwNCiAgICAgICAgICAgICBlbGxpcHNlLnR5cGUgPSAiY29udmV4IiwgDQogICAgICAgICAgICAgZ2d0aGVtZSA9IHRoZW1lX2J3KCkNCikNCg0KYGBgDQoNCmBgYHtyfQ0KZGF0YV9rIDwtIG11dGF0ZShkYXRhLCBjbHVzdGVyID1rW1siY2x1c3RlciJdXSkgIyBPbiBjcsOpZXIgdW4gZGF0YWZyYW1lIG/DuSBsJ29uIGFqb3V0ZSBsZXMgY2x1c3RlcnMgZHUga21lYW5zDQoNCkt0YWIgPC0gdGFibGUoZGF0YV9rJGlzX2dlbnVpbmUsZGF0YV9rJGNsdXN0ZXIpICMgT24gY2FsY3VsIHVuIHRhYmxlYXUgY3JvaXPDqSAsIHBvdXIgdm9pciBsZXMgdnJhaSAvZmF1eCBwb3NpdGlmcyAuLi4uLi5WL0YgbsOpZ2F0aWYNCg0KS3RhYiAjIFRhYmxlYXUgDQoNCmNwcm9wKEt0YWIpICMgT24gZXhwcmltZSBjZSB0YWJsZWF1IGVuIHRlcm1lIGRlIHBvdXJjZW50YWdlIA0KYGBgDQogUHJvYmFiaWxpdMOpIGQnYXZvaXIgdW4gYmlsbGV0IHZyYWkgw6AgdG9ydCAxMC40JSAgKHBlbnNhbnQgcXUnaWwgZXN0IGZhdXgpDQogDQogT24gYSAgMS4xICUgZCdhdm9pciB1biBiaWxsZXQgRmF1eCBwZW5zYW50IHF1J2lsIGVzdCBWcmFpIA0KDQogTW9kw6hsZSBkZSBLbWVhbnMgw6AgZGV1eCBkaW1lbnNpb25zIGVzdCBhc3NleiBmaWFibGUgZGFucyBsYSBkw6l0ZWN0aW9uIGRlIGZhdXggYmlsbGV0cyA6IDg5LjYgJSBkZSBkw6l0ZWN0aW9uIGRlIGZhdXggYmlsbGV0cyDDoCByYWlzb24uDQogDQogDQogDQojIyBIQ1BDIA0KDQoNCmBgYHtyIEhDUEMxfQ0KcmVzLkhDUEMxPC1IQ1BDKHJlcy5QQ0EsbmIuY2x1c3Q9Mixjb25zb2w9RkFMU0UsZ3JhcGg9RkFMU0UpDQoNCmRhdGFfSENQQzEgPC0gbXV0YXRlKGRhdGEsIGNsdXN0ZXIgPSByZXMuSENQQzFbWyJkYXRhLmNsdXN0Il1dW1siY2x1c3QiXV0pDQoNCkh0YWIgPC0gdGFibGUoZGF0YV9IQ1BDMSRpc19nZW51aW5lLGRhdGFfSENQQzEkY2x1c3RlcikNCg0KSHRhYg0KDQpjcHJvcChIdGFiKSAjIE1laWxsZXVyIG1vZMOobGUgcXVlIGxlIEttZWFucyAsIE9uIHBhc3NlIGRlIDg5LjYgJSDDoCA5Ny4yICUgZGUgZMOpdGVjdGlvbiBkZSBmYXV4IGJpbGxldCDDoCByYWlzb24uDQoNCmBgYA0KTWVpbGxldXIgbW9kw6hsZSBxdWUgbGUgSyBtZWFucyAoc2FucyByw6lkdWN0aW9uIGRlIGRpbWVuc2lvbikgLCBPbiBwYXNzZSBkZSA4OS42ICUgw6AgOTcuMiAlIGRlIGTDqXRlY3Rpb24gZGUgZmF1eCBiaWxsZXQgw6AgcmFpc29uLg0KDQojIyBSw6lkdWN0aW9uIHBhciBBQ1AgSENQQyArIEsgbWVhbnMNCg0KYGBge3J9DQpyZXMuUENBMjwtUENBKGRhdGEsbmNwPTMscXVhbGkuc3VwPWMoMSksZ3JhcGg9RkFMU0UpDQpyZXMuSENQQzwtSENQQyhyZXMuUENBMixuYi5jbHVzdD0yLGtrPTEwMCxjb25zb2w9RkFMU0UsZ3JhcGg9RkFMU0UpDQpwbG90LkhDUEMocmVzLkhDUEMsY2hvaWNlPSd0cmVlJyx0aXRsZT0nQXJicmUgaGnDqXJhcmNoaXF1ZScpDQpwbG90LkhDUEMocmVzLkhDUEMsY2hvaWNlPSdtYXAnLGRyYXcudHJlZT1GQUxTRSx0aXRsZT0nUGxhbiBmYWN0b3JpZWwnKQ0KDQoNCmRhdGFfSENQQyA8LSBtdXRhdGUoZGF0YSwgY2x1c3RlciA9IHJlcy5IQ1BDW1siZGF0YS5jbHVzdCJdXVtbImNsdXN0Il1dKQ0KDQpIQ1BDdGFiIDwtIHRhYmxlKGRhdGFfSENQQyRpc19nZW51aW5lLGRhdGFfSENQQyRjbHVzdGVyKQ0KSENQQ3RhYg0KDQpjcHJvcChIQ1BDdGFiKSAjIE1vZMOobGUgbmV0dGVtZW50IG1vaW5zIHBlcmZvcm1hbnQgcG91ciBsYSBkw6l0ZWN0aW9uIGRlIGZhdXggYmlsbGV0cyAuDQoNCmZ2aXpfY2x1c3RlcihyZXMuSENQQywNCiAgICAgICAgICAgICByZXBlbCA9IFRSVUUsICAgICAgICAgICAgDQogICAgICAgICAgICAgc2hvdy5jbHVzdC5jZW50ID0gVFJVRSwgDQogICAgICAgICAgICAgcGFsZXR0ZSA9ICJqY28iLCAgICAgICAgIA0KICAgICAgICAgICAgIGdndGhlbWUgPSB0aGVtZV9taW5pbWFsKCksDQogICAgICAgICAgICAgbWFpbiA9ICJGYWN0b3IgbWFwIg0KKQ0KDQpgYGANCg0KTW9kw6hsZSBuZXR0ZW1lbnQgbW9pbnMgcGVyZm9ybWFudCBwb3VyIGxhIGTDqXRlY3Rpb24gZGUgZmF1eCBiaWxsZXRzIA0KDQoNCg0KIyMgSENQQyArIEsgbWVhbnMgLCBzYW5zIHLDqWR1Y3Rpb24gZGUgZGltZW5zaW9uIA0KDQpgYGB7ciwgY29sbGFwc2U9VFJVRX0NCiMgU0FOUyBSZWR1Y3Rpb24gZGVzIGRpbWVuc2lvbnMgIFBDQSBLbWVhbiArIEhDUEMNCg0KcmVzLkhDUEMyPC1IQ1BDKHJlcy5QQ0EsbmIuY2x1c3Q9Mixraz0xMDAsY29uc29sPUZBTFNFLGdyYXBoPUZBTFNFKQ0KDQpkYXRhX0hDUEMyIDwtIG11dGF0ZShkYXRhLCBjbHVzdGVyID0gcmVzLkhDUEMyW1siZGF0YS5jbHVzdCJdXVtbImNsdXN0Il1dKQ0KDQp0YWJsZShkYXRhX0hDUEMyJGlzX2dlbnVpbmUsZGF0YV9IQ1BDMiRjbHVzdGVyKQ0KDQpjcHJvcCh0YWJsZShkYXRhX0hDUEMyJGlzX2dlbnVpbmUsZGF0YV9IQ1BDMiRjbHVzdGVyKSkNCg0KIyBNw6ptZSByw6lzdWx0YXQgcXVlIEhDUEMgc2FucyBLbWVhbnMgLCBjJ2VzdCBwb3VyIGwnaW5zdGFudCBub3RyZSBtZWlsbGV1ciBtb2TDqGxlIC4NCg0KYGBgDQpRdWFzaW1lbnQgbGUgbcOqbWUgcsOpc3VsdGF0IHF1ZSBIQ1BDIHNhbnMgSy1NZWFucy4NCkMnZXN0IHVuIG1laWxsZXVyIG1vZMOobGUgcG91ciBsYSBkw6l0ZWN0aW9uIGRlIGZhdXggYmlsbGV0cy4NClVuZSBtZWlsbGV1cmUgZMOpdGVjdGlvbiBkZXMgdnJhaXMgYmlsbGV0cyBlc3QgYXVzc2kgw6AgY29uc3RhdGVyLg0KDQoNCg0KIyBNaXNzaW9uIDMgOiBSw6lncmVzc2lvbiBsb2dpc3RpcXVlIA0KDQojIyBNw6l0aG9kZSAxIFRyYWluIGFuZCBUZXN0IA0KDQojIyMgUGFydGl0aW9uDQpgYGB7ciBQYXJ0aXRpb24gfQ0KDQojIyBSZWNvZGFnZSBkZSBkYXRhJGlzX2dlbnVpbmUNCmRhdGEkaXNfZ2VudWluZSA8LSBmY3RfcmVjb2RlKGRhdGEkaXNfZ2VudWluZSwNCiAgIjAiID0gIkZhbHNlIiwNCiAgIjEiID0gIlRydWUiDQopDQoNCiMgUGFydGl0aW9uDQpzZXQuc2VlZCgxMDApIA0KdHJhaW5JbmRleCA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKGRhdGEkaXNfZ2VudWluZSxwPTAuNyxsaXN0PUYpIA0KcHJpbnQobGVuZ3RoKHRyYWluSW5kZXgpKSANCnByaW50KGhlYWQodHJhaW5JbmRleCwxMCkpDQoNCg0KYGBgDQoNCiMjIyBUcmFpbiBhbmQgVGVzdA0KYGBge3IgVHJhaW4gYW5kIFRlc3R9DQojZGF0YSBmcmFtZSBwb3VyIGxlcyBpbmRpdmlkdXMgZW4gYXBwcmVudGlzc2FnZSANCg0KVHJhaW4gPC0gZGF0YVt0cmFpbkluZGV4LF0gDQoNCnByaW50KGRpbShUcmFpbikpDQoNCiNkYXRhIGZyYW1lIHBvdXIgbGVzIGluZGl2aWR1cyBlbiB0ZXN0DQoNClRlc3QgPC0gZGF0YVstdHJhaW5JbmRleCxdDQoNCnByaW50KGRpbShUZXN0KSkgDQoNCiNmcsOpcXVlbmNlcyBhYnNvbHVlcyBkZXMgY2xhc3NlcyAtIMOpY2guIGQnYXBwcmVudGlzc2FnZQ0KDQpwcmludCh0YWJsZShUcmFpbiRpc19nZW51aW5lKSkNCg0KI2Zyw6lxdWVuY2VzIHJlbGF0aXZlcyBkZXMgY2xhc3NlcyBkYW5zIGwnw6ljaC4gZCdhcHByZW50aXNzYWdlDQoNCnByaW50KHByb3AudGFibGUodGFibGUoVHJhaW4kaXNfZ2VudWluZSkpKQ0KDQpwcmludChwcm9wLnRhYmxlKHRhYmxlKGRhdGEkaXNfZ2VudWluZSkpKSAjIE3Dqm1lIHLDqXBhcnRpdGlvbiBlbnRyZSBkZiBvcmlnaW5hbCBldCDDqWNoYW50aWxsb24gZCdhcHByZW50aXNzYWdlDQpgYGANCg0KDQojIyMgTW9kw6lsaXNhdGlvbiBkZSBsYSByw6lncmVzc2lvbiBsb2dpc3RpcXVlIA0KYGBge3IsIHdhcm5pbmc9RkFMU0V9DQojIE1vZMOpbGlzYXRpb24gUsOpZ3Jlc3Npb24gTG9naXN0aXF1ZSANCg0KI3BhcmFtw6h0cmUgZHUgcHJvY2Vzc3UgZCdhcHByZW50aXNzYWdlIA0KZml0Q29udHJvbCA8LSB0cmFpbkNvbnRyb2wobWV0aG9kPSJub25lIikNCg0KDQojIGFwcHJlbnRpc3NhZ2UgLSByw6lncmVzc2lvbiBsb2dpc3RpcXVlDQptX2xyIDwtIHRyYWluKGlzX2dlbnVpbmUgfiAuLCBkYXRhID0gVHJhaW4sbWV0aG9kPSJnbG0iLHRyQ29udHJvbD1maXRDb250cm9sKQ0KDQojY29lZmZpY2llbnRzIGRlIGxhIHLDqWdyZXNzaW9uIGxvZ2lzdGlxdWUgDQpwcmludChtX2xyJGZpbmFsTW9kZWwpIA0KDQoNCiNwcmVkaWN0aW9uDQoNCnByZWQgPC0gcHJlZGljdChtX2xyLG5ld2RhdGE9VGVzdCkNCg0KcHJpbnQodGFibGUocHJlZCkpICMgNDAgJSAvIDYwICUgb2sgIQ0KDQpgYGANCiMjIyBNYXRyaWNlIGRlIGNvbmZ1c2lvbiANCmBgYHtyfQ0KI21hdHJpY2UgZGUgY29uZnVzaW9uIA0KDQptYXQgPC0gY29uZnVzaW9uTWF0cml4KGRhdGE9cHJlZCxyZWZlcmVuY2U9VGVzdCRpc19nZW51aW5lKQ0KDQpwcmludChtYXQpDQoNCmBgYA0KDQpJbmRpY2F0ZXVycyBnbG9iYXV4DQpgYGB7cn0NCiNhY2PDqHMgYXV4IGluZGljYXRldXJzIGdsb2JhdXgNCg0KcHJpbnQobWF0JG92ZXJhbGwpDQpgYGANCg0KDQojIyMgQ291cmJlIExpZnQgDQpgYGB7ciwgd2FybmluZz1GQUxTRX0NCiMjIyBDb3VyYmUgTGlmdCAtLS0tLS0NCg0KI3Njb3JlIGRlcyBpbmRpdmlkdXMgcG9zaXRpZnMgDQpzY29yZSA8LSBwcmVkaWN0KG1fbHIsVGVzdCx0eXBlPSJwcm9iIilbLCIxIl0gDQoNCiN0YWJsZWF1IGRlIGRvbm7DqWVzIHBvdXIgbGUgc2NvcmluZw0KbGlmdGRhdGEgPC0gZGF0YS5mcmFtZShjbGFzc2U9VGVzdCRpc19nZW51aW5lKQ0KbGlmdGRhdGEkc2NvcmUgPC0gc2NvcmUgDQoNCiNvYmpldCBsaWZ0IA0KDQpsaWZ0X29iaiA8LSBsaWZ0KGNsYXNzZSB+IHNjb3JlLCBkYXRhPWxpZnRkYXRhLCBjbGFzcz0iMSIpIA0KDQojYWZmaWNoYWdlIGRlIGxhIGNvdXJiZSBsaWZ0DQpwbG90KGxpZnRfb2JqKQ0KDQoNCmBgYA0KDQoNCiMjIyBDb3VyYmUgUk9DIGV0IEFVQyANCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQojIyMgQ291cmJlIFJPQyBldCBBVUMgLS0tLS0tDQoNCg0KbGlicmFyeShwUk9DKQ0KDQojb2JqZXQgcm9jDQoNCnJvY19vYmogPC0gcm9jKFRlc3QkaXNfZ2VudWluZT09IjEiLHNjb3JlKQ0KDQojcGxvdCBkZSBsJ29iamV0IHJvYw0KDQpwbG90KDEtcm9jX29iaiRzcGVjaWZpY2l0aWVzLHJvY19vYmokc2Vuc2l0aXZpdGllcyx0eXBlPSJsIikgDQphYmxpbmUoMCwxKSANCg0KIyBBVUMgDQpwcmludChyb2Nfb2JqJGF1YykgIyBBcmVhIHVuZGVyIHRoZSBjdXJ2ZTogMC45OTg0DQpgYGANCg0KIE5vdXMgYXZvbnMgIG1vZMOobGUgYXZlYyBkZSBib25zIGluZGljYXRldXJzIGRlIGZpYWJpbGl0w6lzLCBjZXBlbmRhbnQgbGVzIGRvbm7DqWVzIHNvbnQgcGV1IG5vbWJyZXVzZXMuDQoNCiBOb3VzIGFsbG9ucyB0ZXN0ZXIgdW5lIGF1dHJlIG3DqXRob2RlIHBsdXMgYWRhcHTDqWUgw6Agbm9zIGRvbm7DqWVzLg0KDQogTGEgdmFsaWRhdGlvbiBjcm9pc8OpZSBzdHJhdGlmacOpZS4gDQoNCg0KIyMgbcOpdGhvZGUgMiDDqXZhbHVhdGlvbiBwYXIgcsOpw6ljaGFudGlsbG9ubmFnZQ0KDQpgYGB7ciwgd2FybmluZz1GQUxTRX0NCmZpdENvbnRyb2wgPC0gdHJhaW5Db250cm9sKG1ldGhvZD0iY3YiLG51bWJlcj0xMCkgDQptX2xyIDwtIHRyYWluKGlzX2dlbnVpbmUgfiAuLCBkYXRhID0gVHJhaW4sbWV0aG9kPSJnbG0iLHRyQ29udHJvbD1maXRDb250cm9sKSANCnByaW50KG1fbHIpDQpwcmludCh2YXJJbXAobV9scikpIA0KcHJpbnQobV9sciRyZXNhbXBsZSkNCg0KYGBgDQoNCiMjIyBNw6l0aG9kZSBpbnTDqWdyw6kgZGUgc8OpbGVjdGlvbiAsIFN0ZXB3aXNlIHBhciBBSUMgDQpgYGB7ciwgd2FybmluZz1GQUxTRX0NCiNtw6l0aG9kZSBpbnTDqWdyw6llIGRlIHPDqWxlY3Rpb24gDQptX2xycyA8LSB0cmFpbihpc19nZW51aW5lIH4gLiwgZGF0YSA9IFRyYWluLCBtZXRob2Q9ImdsbVN0ZXBBSUMiLCANCiAgICAgICAgICAgICAgIHRyQ29udHJvbD10cmFpbkNvbnRyb2woIm5vbmUiKSkNCg0KDQpwcmludChtX2xycyRmaW5hbE1vZGVsKQ0KYGBgDQoNCk9uIHRlc3RlIA0KDQpgYGB7cn0NCiMgYXBwbGljYXRpb24gc3VyIGxlIHRlc3Qgc2V0IC0gbWVzdXJlIGRlcyBwZXJmb3JtYW5jZXMgDQpwcmludChjb25mdXNpb25NYXRyaXgoZGF0YT1wcmVkaWN0KG1fbHJzLG5ld2RhdGEgPSANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBUZXN0KSxyZWZlcmVuY2U9VGVzdCRpc19nZW51aW5lKSkgDQpgYGANCg0KUGVyZm9ybWFuY2UgbMOpZ8OocmVtZW50IG1vaW5zIGJvbm5lIHF1ZSBsZSBtb2TDqGxlICJUcmFpbiBhbmQgVGVzdCIuDQpDZXBlbmRhbnQgY2UgcsOpc3VsdGF0IGVzdCBhdHRlbmR1Lg0KTGEgc3RyYXRpZmljYXRpb24gY3JvaXPDqWUgZG9ubmUgZ8OpbsOpcmFsZW1lbnQgdW4gbW9kw6hsZSBwbHVzIGZpYWJsZSBwb3VyIGxlcyBwZXRpdHMgamV1eCBkZSBkb25uw6llcy4NCg0KDQoNCg0KDQojIyMgUHJvZ3JhbW1lIGRlIGTDqXRlY3Rpb24gZGUgZmF1eCBiaWxsZXRzIA0KYGBge3IgcHJvZ3JhbW1lIGTDqXRlY3Rpb24gfQ0KYmlsbGV0cy50ZXN0ICA9IHJlYWQudGFibGUoInRlc3Rfbm90ZXMuY3N2Iiwgc2VwPScsJywgZGVjID0gJy4nLCBoZWFkZXIgPSBUKQ0Kcm93bmFtZXMoYmlsbGV0cy50ZXN0KSA9IGJpbGxldHMudGVzdCRpZA0KI2JpbGxldHMudGVzdCA8LSBiaWxsZXRzLnRlc3QgJT4lIHNlbGVjdCgtaWQpDQoNCg0KIyBjYWNsdWwgZGVzIHByb2JhYmlsaXTDqXMNCg0KYmlsbGV0LnRlc3QucHJvYi52cmFpID0gcHJlZGljdChtX2xycywgbmV3ZGF0YSA9IGJpbGxldHMudGVzdFssYmlsbGV0LnZhci5kaW1dLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB0eXBlPSJwcm9iIikNCg0KYmlsbGV0LnRlc3QucHJvYi5mYXV4ID0gMSAtIGJpbGxldC50ZXN0LnByb2IudnJhaQ0KDQpiaWxsZXRfdCA8LSBjYmluZChiaWxsZXQudGVzdC5wcm9iLnZyYWksYmlsbGV0cy50ZXN0JGlkKQ0KDQoNCmZvciAoaSBpbiAxOmxlbmd0aChiaWxsZXQudGVzdC5wcm9iLnZyYWkkYDFgKSkgew0KICBjYXQoJy0gQmlsbGV0JyxpLCAnXHQgUChWUkFJKSA9ICcsIGJpbGxldC50ZXN0LnByb2IudnJhaSRgMWBbaV0sICAnXG4nKQ0KICBpZiAoYmlsbGV0LnRlc3QucHJvYi52cmFpJGAxYFtpXSA8IDAuNSkgew0KICAgIGNhdCgiXHRcdCAtLT4gRkFVWCBCSUxMRVRcblxuIikNCiAgfSBlbHNlIHsNCiAgICBjYXQoIlx0XHQgLS0+IFZSQUkgQklMTEVUXG5cbiIpDQogIH0NCn0NCmBgYA0KVsOpcmlmaW9ucyBub3RyZSBwcm9ncmFtbWUgw6AgbCdhaWRlIGQndW4gZmljaGllciByw6lwb25zZS4gDQoNCmBgYHtyIHbDqXJpZmljYXRpb24gZHUgcHJvZ3JhbW1lfQ0KcmVhZC50YWJsZSgidGVzdF9ub3Rlc193aXRoX2xhYmVscy5jc3YiLCBoZWFkZXIgPSBULCBzZXA9JywnKQ0KYGBgDQoNCk9uIHRyb3V2ZSBsZSBtw6ptZSByw6lzdWx0YXQsICDDoCBzYXZvaXIgOg0KDQotIEJpbGxldCAxIDogVnJhaQ0KLSBCaWxsZXQgMiA6IEZhdXgNCi0gQmlsbGV0IDMgOiBWcmFpDQotIEJpbGxldCA0IDogRmF1eA0KLSBCaWxsZXQgNSA6IEZhdXggDQoNCg0KIyMgUG91ciBhbGxlciBwbHVzIGxvaW4gLCBsJ2FsZ29yaXRobWUgU1ZNIDogICpzdXBwb3J0LXZlY3RvciBtYWNoaW5lKiANCg0KDQpPbiBjaGVyY2hlIGxlcyBtZWlsbGV1cnMgcGFyYW3DqHRyZXMgZHUgbW9kw6hsZSANCmBgYHtyfQ0KIyMjIEh5cGVyIFBhcmFtw6h0cmUgQyAtLS0tLS0tDQoNCiNwYXJhbcOodHJlcyBkJ2FwcHJlbnRpc3NhZ2UgDQpmaXRDb250cm9sIDwtIHRyYWluQ29udHJvbChtZXRob2Q9ImN2IixudW1iZXI9NSkgDQoNCiNtb2TDqWxpc2F0aW9uIGF2ZWMgcGFyYW3DqHRyZSBkZSBsYSB0ZWNobmlxdWUgZCdhcHByZW50aXNzYWdlIA0KDQojU1ZNIGF2ZWMgbm95YXUgbGluw6lhaXJlLCBDID0gMC4xIA0KbV9zdm0gPC0gdHJhaW4oaXNfZ2VudWluZSB+IC4sIGRhdGEgPSBUcmFpbixtZXRob2Q9InN2bUxpbmVhciIsdHJDb250cm9sPWZpdENvbnRyb2wsdHVuZUdyaWQ9ZGF0YS5mcmFtZShDPTAuMSkpIA0KcHJpbnQobV9zdm0pDQoNCm1fc3ZtZyA8LSB0cmFpbihpc19nZW51aW5lIH4gLiwgZGF0YSA9IFRyYWluLG1ldGhvZD0ic3ZtTGluZWFyIix0ckNvbnRyb2w9Zml0Q29udHJvbCx0dW5lR3JpZD1kYXRhLmZyYW1lKEM9YygwLjA1LDAuMSwwLjUsMSwxMCkpKQ0KDQpwcmludChtX3N2bWcpDQoNCmBgYA0KDQoNCk9uIHRlc3RlIG5vdHJlIG1vZMOobGUgU1ZNIA0KYGBge3J9DQpwcmludChjb25mdXNpb25NYXRyaXgoZGF0YT1wcmVkaWN0KG1fc3ZtZyxuZXdkYXRhID0gDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgVGVzdCkscmVmZXJlbmNlPVRlc3QkaXNfZ2VudWluZSxwb3NpdGl2ZT0iMSIpKQ0KYGBgDQoNCjEwMCAlIGRlIGJvbm5lIHLDqXBvbnNlICEgDQoNCkwnYWxnb3JpdGhtZSBTVk0gYSBkZSBtZWlsbGV1cmVzIHBlcmZvcm1hbmNlcy4=