CONSTRUCTION D’UN CLASSIFIEUR BAYESIEN NAIF EN R

Fouille de données avec R Léa Lê Dinh : Esiee Paris 2022-2023

Le classificateur bayésien naïf est un algorithme d’apprentissage très utilisé en Machine Learning. Il est basé sur le théorème probabiliste de Bayes. Le classifieur bayésien naïf suppose que l’existence d’une variable explicative pour une classe, est indépendante de l’existence d’autres variables explicatives.

1. Création du Dataframe

Tout d’abord, nous installons les librairies dont nous aurons besoin.

rm(list = ls())       # initialisation
library(kableExtra)   # chargement du paquet
library('e1071')
library(caret)
## Le chargement a nécessité le package : ggplot2
## Le chargement a nécessité le package : lattice

Puis, nous créons un Dataframe df_1 et entrons les valeurs dont nous avons besoin.

var_1 <- c('<30', '30-50', '30-50', '30-50', '>50')
var_2 <- c('<20', '<20', '<20', '>20', '>20')
var_3 <- c('Oui', 'Non', 'Oui', 'Non', 'Non')
var_4 <- c('Non', 'Oui', 'Oui', 'Non', 'Oui')

df_1 <- data.frame('Salaire' = var_1,
                   'Impots' = var_2,
                   'Etudiant' = var_3,
                   'Controle' = var_4)

Nous l’affichons :

df_1 %>% kbl(digits=3) %>%    
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>% 
  scroll_box( height = "250px")
Salaire Impots Etudiant Controle
<30 <20 Oui Non
30-50 <20 Non Oui
30-50 <20 Oui Oui
30-50 >20 Non Non
>50 >20 Non Oui

Nous scindons le Dataframe en 2 Dataframes. Le premier, appelé X, contient les 3 premières colonnes de df_1 et le second, appelé Y, contient la dernière colonne de df_1. X correspond aux variables prédictives et Y contient la variable à prédire.

#Dataframe df_2 créé en isolant la 4e colonne de df_1
Y <- as.vector(df_1[,c(4)])
data.frame(Y=Y) %>% kbl(digits=3) %>%
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>%
  scroll_box( height = "250px")
Y
Non
Oui
Oui
Non
Oui 
is.vector(Y)
## [1] TRUE
#Suppression de la dernière colonne du dataframe df_1
X <- df_1[,-4]

X %>% kbl(digits=3) %>%    
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>% 
  scroll_box( height = "250px")
Salaire Impots Etudiant
<30 <20 Oui
30-50 <20 Non
30-50 <20 Oui
30-50 >20 Non
>50 >20 Non 
# data.frame(Y=Y) %>% kbl(digits=3) %>%    
#   kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>% 
#   scroll_box( height = "250px")

2. Probabilités conditionnelles

2.1 Tableau de contingence

Nous créons des tableaux de contingence entre chaque variable explicative et la variable à prédire.

Nous obtenons donc 3 tableaux de contingence (Salaire/Controle, Impots/Controle, Etudiant/Controle).

Nous stockons les tableaux dans une liste que nous appelons tabcont.

tabcont <- lapply(X,function(x) {y = table(Y,x)})
tabcont
## $Salaire
##      x
## Y     <30 >50 30-50
##   Non   1   0     1
##   Oui   0   1     2
## 
## $Impots
##      x
## Y     <20 >20
##   Non   1   1
##   Oui   2   1
## 
## $Etudiant
##      x
## Y     Non Oui
##   Non   1   1
##   Oui   2   1
2.2 Probabilités conditionnelles corrigées

Nous modifions les tableaux de contingence précédemment créés.

Nous obtenons la liste des probabilités conditionnelles que nous appelons prop_cond.

#m = vaut par défaut 1
m = 1
#k = nombre de facteur de la variable à prédire
k = 2

#nk est notre tableau

prob_cond <- lapply(X, function(x){
  tabcont1 <- table(Y,x)
  tabcont2 <- tabcont1 + m
  tabcont3 <- rowSums(tabcont1)+k*m
  tabcont4 <- tabcont2/tabcont3
  return(tabcont4)
})

print(prob_cond)
## $Salaire
##      x
## Y      <30  >50 30-50
##   Non 0.50 0.25  0.50
##   Oui 0.20 0.40  0.60
## 
## $Impots
##      x
## Y     <20 >20
##   Non 0.5 0.5
##   Oui 0.6 0.4
## 
## $Etudiant
##      x
## Y     Non Oui
##   Non 0.5 0.5
##   Oui 0.6 0.4

3. Prédiction et vraisemblance

3.1 Prédiction et vraisemblance

Nous cherchons à déterminer, pour chaque individu test, quelles sont les probabilités d’appartenance aux groupes (contrôle = Oui - contrôle = Non) en connaissant les valeurs des variables prédictives (contenue dans le dataframe X).

La probabilité d’appartenance à priori correspond à la probabilité qu’un individu ait un contrôle ou non. Les résultats sont stockés dans un vecteur priori.

#Permet de compter le nombre d'individus dans chaque catégorie (oui/non)
#prob.table
nb_cont <- table(df_1$Controle)

print(nb_cont)
## 
## Non Oui 
##   2   3
#On transforme en probabilités
priori <- nb_cont/sum(nb_cont)

print(priori)
## 
## Non Oui 
## 0.4 0.6
priori_labels <- c("Non", "Oui")
print(priori_labels)
## [1] "Non" "Oui"

Nous créons un nouveau dataframe data_test :

var_1 <- c('30-50', '>50', '<30')
var_2 <- c('<20', '<20', '<20')
var_3 <- c('Oui', 'Non', 'Oui')
var_4 <- c('Oui', 'Oui', 'Non')

data_test <- data.frame('Salaire' = var_1,
                   'Impots' = var_2,
                   'Etudiant' = var_3,
                   'Pred' = var_4)

data_test %>% kbl(digits=3) %>%    
  kable_styling(bootstrap_options = "striped", full_width = F, position = "center", latex_options = 'stripped') %>% 
  scroll_box( height = "250px")
Salaire Impots Etudiant Pred
30-50 <20 Oui Oui
>50 <20 Non Oui
<30 <20 Oui Non
3.2 Appartenance a priori

Il faut écrire 3 boucles “for” l’une dans l’autre afin de sélectionner un individu, puis extraire les probabilités a priori, puis extraire les probabilités conditionnelles.

# On initialise lnV comme étant un dataframe vide 
lnV <- data.frame()

# Première boucle : on sélectionne l'individu entre 1 et nombre total d'individu de data_test, soit le nombre de lignes de data_test
for(i in 1 : nrow(data_test)) {
  logS <- 0
  
  #Deuxième boucle : on extrait la probabilité priori
  for(j in 1 : length(priori)){
  
    #Troisième boucle : pour k entre 1 et 3 (longueur de la liste des tableaux de contingence prob_cond)
    for(k in 1 : length(prob_cond)){
      p <- prob_cond[[k]][j,data_test[i,k]]
      logS <- logS + log(p)
    }
    
    if(j==1){
    # Ajout la valeur de logS + log(priori[1]) à la colonne "Oui" du dataframe lnV
    lnV[i,"Oui"] <- logS + log(priori[j])
    }
    
    else{
    # Ajout la valeur de logS + log(priori[2]) à la colonne "Non" du dataframe lnV
    lnV[i,"Non"] <- logS + log(priori[j])
    }
    logS<-0
  }
}

print(lnV)
##         Oui       Non
## 1 -2.995732 -2.448768
## 2 -3.688879 -2.448768
## 3 -2.995732 -3.547380

4. Fonctions

Dans cette partie, nous utilisons les scripts précédemment écrits afin de créeer deux fonctions. Ces deux fonctions nous permettent de réutiliser le code indépendamment du nombre de variables contenues dans la base de données et du nombre de catégories (labels).

4.1 Naive_Bayes

La première fonction Naive_Bayes nous permet d’obtenir : - Les tableaux de contingence avec les probabilités conditionnelles corrigées - Les probabilités d’appartenance à priori

Ces résultats seront contenus dans une liste “out”.

Naive_Bayes <- function(X,Y,m,k){
  
  prob_cond <- lapply(X, function(x){
  tabcont1 <- table(Y,x)
  tabcont2 <- tabcont1 + m
  tabcont3 <- rowSums(tabcont1)+k*m
  tabcont4 <- tabcont2/tabcont3
  return(tabcont4)
  })
  
  priori <- nb_cont/sum(nb_cont)
  
  out <- list("prob_cond" = prob_cond, "priori" = priori)
}

Nous utilisons cette fonction sur notre dataframe.

naive_data <-  Naive_Bayes(X,Y,m=1,2)
print(naive_data)
## $prob_cond
## $prob_cond$Salaire
##      x
## Y      <30  >50 30-50
##   Non 0.50 0.25  0.50
##   Oui 0.20 0.40  0.60
## 
## $prob_cond$Impots
##      x
## Y     <20 >20
##   Non 0.5 0.5
##   Oui 0.6 0.4
## 
## $prob_cond$Etudiant
##      x
## Y     Non Oui
##   Non 0.5 0.5
##   Oui 0.6 0.4
## 
## 
## $priori
## 
## Non Oui 
## 0.4 0.6
4.2 Predict_Bayes

5. Déploiement

Nous allons utiliser les fonctions précédemment écrites sur un jeu de données contenant 4000 instances.

load('data_test.Rda')

X <- data_test[,-12]
Y <- data_test$event
naive_datatest <- Naive_Bayes(X,Y,m=1,2)
print(naive_datatest)
## $prob_cond
## $prob_cond$age
##      x
## Y       level_1   level_2   level_3   level_4
##   vv  0.2788365 0.2562688 0.3099298 0.1559679
##   dcd 0.1353234 0.2034826 0.3502488 0.3119403
## 
## $prob_cond$cpk
##      x
## Y        Normal     Eleve
##   vv  0.6549649 0.3450351
##   dcd 0.6462687 0.3537313
## 
## $prob_cond$height
##      x
## Y       level_1   level_2   level_3   level_4
##   vv  0.1213641 0.3204614 0.4242728 0.1349047
##   dcd 0.1199005 0.3328358 0.3915423 0.1567164
## 
## $prob_cond$frac
##      x
## Y        level_1    level_2    level_3    level_4
##   vv  0.30391174 0.41825476 0.22718154 0.05165496
##   dcd 0.17810945 0.38308458 0.32835821 0.11144279
## 
## $prob_cond$hbp
##      x
## Y       level_1
##   vv  0.9994985
##   dcd 0.9995025
## 
## $prob_cond$ap_lo
##      x
## Y          level_1      level_2      level_3
##   vv  0.9974924774 0.0025075226 0.0005015045
##   dcd 0.9731343284 0.0258706468 0.0014925373
## 
## $prob_cond$creat
##      x
## Y         Faible       Fort      Moyen
##   vv  0.83400201 0.05215647 0.11434303
##   dcd 0.65323383 0.18656716 0.16069652
## 
## $prob_cond$Na
##      x
## Y         Faible       Fort      Moyen
##   vv  0.87562688 0.05917753 0.06569709
##   dcd 0.81194030 0.10149254 0.08706468
## 
## $prob_cond$smoke
##      x
## Y            Non        Oui
##   vv  0.90672016 0.09327984
##   dcd 0.91343284 0.08656716
## 
## $prob_cond$alco
##      x
## Y            Non        Oui
##   vv  0.94684052 0.05315948
##   dcd 0.94577114 0.05422886
## 
## $prob_cond$active
##      x
## Y           Non       Oui
##   vv  0.1895687 0.8104313
##   dcd 0.2238806 0.7761194
## 
## 
## $priori
## 
## Non Oui 
## 0.4 0.6

Nous comparons les résultats avec la fonction naiveBayes qui existe sur R.

naiveR <- naiveBayes(event ~ ., data = data_test)
print(naiveR)
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##    vv   dcd 
## 0.498 0.502 
## 
## Conditional probabilities:
##      age
## Y       level_1   level_2   level_3   level_4
##   vv  0.2786145 0.2560241 0.3097390 0.1556225
##   dcd 0.1349602 0.2031873 0.3500996 0.3117530
## 
##      cpk
## Y        Normal     Eleve
##   vv  0.6551205 0.3448795
##   dcd 0.6464143 0.3535857
## 
##      height
## Y       level_1   level_2   level_3   level_4
##   vv  0.1209839 0.3202811 0.4241968 0.1345382
##   dcd 0.1195219 0.3326693 0.3914343 0.1563745
## 
##      frac
## Y        level_1    level_2    level_3    level_4
##   vv  0.30371486 0.41817269 0.22690763 0.05120482
##   dcd 0.17778884 0.38296813 0.32818725 0.11105578
## 
##      hbp
## Y     level_1
##   vv        1
##   dcd       1
## 
##      ap_lo
## Y          level_1      level_2      level_3
##   vv  0.9979919679 0.0020080321 0.0000000000
##   dcd 0.9736055777 0.0253984064 0.0009960159
## 
##      creat
## Y         Faible       Fort      Moyen
##   vv  0.83433735 0.05170683 0.11395582
##   dcd 0.65338645 0.18625498 0.16035857
## 
##      Na
## Y         Faible       Fort      Moyen
##   vv  0.87600402 0.05873494 0.06526104
##   dcd 0.81225100 0.10109562 0.08665339
## 
##      smoke
## Y            Non        Oui
##   vv  0.90712851 0.09287149
##   dcd 0.91384462 0.08615538
## 
##      alco
## Y            Non        Oui
##   vv  0.94728916 0.05271084
##   dcd 0.94621514 0.05378486
## 
##      active
## Y           Non       Oui
##   vv  0.1892570 0.8107430
##   dcd 0.2236056 0.7763944

Nous pouvons voir que les résultats sont les mêmes qu’avec la fonction que nous avons écrite.