PMC avec Torch pour R

Importation et préparation des données d’apprentissage

Chargement et inspection

#charger les données train
library(readxl)
DTrain <- readxl::read_excel("breast_train.xlsx")
str(DTrain)

## tibble [399 × 7] (S3: tbl_df/tbl/data.frame)
##  $ ucellsize : num [1:399] 1 3 9 10 8 1 1 1 1 2 ...
##  $ ucellshape: num [1:399] 1 2 7 10 8 1 1 1 1 1 ...
##  $ mgadhesion: num [1:399] 1 1 3 7 4 1 1 1 1 1 ...
##  $ sepics    : num [1:399] 2 3 4 10 10 2 2 2 2 2 ...
##  $ normnucl  : num [1:399] 1 6 7 2 1 1 2 1 1 1 ...
##  $ mitoses   : num [1:399] 1 1 1 1 1 1 1 1 1 1 ...
##  $ classe    : chr [1:399] "begnin" "begnin" "malignant" "malignant" ...

#premières lignes
head(DTrain)

Traitement des descripteurs

#descripteurs dans une structure spécifique
XTrain <- DTrain[,colnames(DTrain)!="classe"]
str(XTrain)

## tibble [399 × 6] (S3: tbl_df/tbl/data.frame)
##  $ ucellsize : num [1:399] 1 3 9 10 8 1 1 1 1 2 ...
##  $ ucellshape: num [1:399] 1 2 7 10 8 1 1 1 1 1 ...
##  $ mgadhesion: num [1:399] 1 1 3 7 4 1 1 1 1 1 ...
##  $ sepics    : num [1:399] 2 3 4 10 10 2 2 2 2 2 ...
##  $ normnucl  : num [1:399] 1 6 7 2 1 1 2 1 1 1 ...
##  $ mitoses   : num [1:399] 1 1 1 1 1 1 1 1 1 1 ...

Standardisation des variables.

#centrage réduction
ZTrain <- scale(XTrain)
head(ZTrain,5)

##        ucellsize ucellshape mgadhesion      sepics   normnucl    mitoses
## [1,] -0.67914682 -0.7367327 -0.5976051 -0.51333433 -0.5889217 -0.3140574
## [2,] -0.01334932 -0.3996268 -0.5976051 -0.05306377  1.0474276 -0.3140574
## [3,]  1.98404317  1.2859028  0.1163004  0.40720678  1.3746975 -0.3140574
## [4,]  2.31694192  2.2972205  1.5441115  3.16883013 -0.2616519 -0.3140574
## [5,]  1.65114442  1.6230087  0.4732532  3.16883013 -0.5889217 -0.3140574

Vérifications.

#vérif.
print("Moyennes")

## [1] "Moyennes"

apply(ZTrain,2,mean)

##     ucellsize    ucellshape    mgadhesion        sepics      normnucl 
## -1.004782e-17  3.725308e-17 -2.124520e-17 -6.311008e-17  3.412846e-17 
##       mitoses 
## -5.612798e-17

print("Ecarts-type")

## [1] "Ecarts-type"

apply(ZTrain,2,sd)

##  ucellsize ucellshape mgadhesion     sepics   normnucl    mitoses 
##          1          1          1          1          1          1

Traitement de la variable cible

Distribution des classes et codage 0/1.

#distribution de la classe
table(DTrain$classe)

## 
##    begnin malignant 
##       267       132

#recodage variable cible
yTrain <- as.numeric(DTrain$classe=="malignant")
table(yTrain)

## yTrain
##   0   1 
## 267 132

Passage au format “tensor”

#chargement de la librairie
#/!\ ttention, à la première utilisation
#on vous demande d'installer des librairies supplémentaires
#une boîte de dialogue apparaît derrière RStudio
#il faut suivre simplement les étapes
library(torch)

#cast en type torch des descripteurs
ts_ZTrain <- torch::torch_tensor(ZTrain)
dim(ts_ZTrain)

## [1] 399   6

#premières valeurs
ts_ZTrain[1:5,]

## torch_tensor
## -0.6791 -0.7367 -0.5976 -0.5133 -0.5889 -0.3141
## -0.0133 -0.3996 -0.5976 -0.0531  1.0474 -0.3141
##  1.9840  1.2859  0.1163  0.4072  1.3747 -0.3141
##  2.3169  2.2972  1.5441  3.1688 -0.2617 -0.3141
##  1.6511  1.6230  0.4733  3.1688 -0.5889 -0.3141
## [ CPUFloatType{5,6} ]

#faire de même pour la cible
ts_yTrain <- torch::torch_tensor(yTrain)
ts_yTrain[1:10]

## torch_tensor
##  0
##  0
##  1
##  1
##  1
##  0
##  0
##  0
##  0
##  0
## [ CPUFloatType{10} ]

Modélisation (PMC) avec Torch pour R

Structure et comportement du réseau

#perceptron multicouche
#classe (format R6)
Mon_PMC <- torch::nn_module(
  "pmc_torch",
  
  #constructeur
  #énumération des objets à utiliser
  initialize = function(p){
    #entrée -> cachée (2 neurones)
    self$layer_1 <- torch::nn_linear(p,2)
    #cachée -> sortie (1 neurone)
    self$layer_2 <- torch::nn_linear(2,1)
    #fonction d'activation 1
    self$ft_1 <- torch::nn_sigmoid()
    #fonction d'activation 2
    self$ft_2 <- torch::nn_sigmoid()
  },
  
  #premier calcul - entrée -> cachée
  forward_1 = function(x){
    #application de la combinaison linéaire
    comb_lin_1 <- self$layer_1(x)
    #appliquer la fonction de transfert
    sig_1 <- self$ft_1(comb_lin_1)
    #renvoyer
    return(sig_1)
  },
  
  #second calcul - cachée -> sortie
  forward_2 = function(x_prim){
    #combinaison linéaire
    comb_lin_2 <- self$layer_2(x_prim)
    #tranfert sigmoïde
    sig_2 <- self$ft_2(comb_lin_2)
    #renvoyer
    return(sig_2)
  },
  
  #enchaînement forward (1 et 2)
  #forward est une fonction prédéfinie
  #qui est aussi la fonction par défaut
  forward = function(x){
    #premier forward
    out_1 <- self$forward_1(x)
    #second forward
    out_2 <- self$forward_2(out_1)
    #sortie du réseau
    return(out_2)
  }  

)

Instanciation et paramétrage.

#instanciation
pmc <- Mon_PMC(ncol(ts_ZTrain))

#caractéristiques du réseau
pmc

## An `nn_module` containing 17 parameters.
## 
## ── Modules ─────────────────────────────────────────────────────────────────────
## • layer_1: <nn_linear> #14 parameters
## • layer_2: <nn_linear> #3 parameters
## • ft_1: <nn_sigmoid> #0 parameters
## • ft_2: <nn_sigmoid> #0 parameters

Choix de la fonction de perte à optimiser.

#critère à optimiser
critere <- torch::nn_mse_loss()

Algorithme d’optimisation.

#algo. d'apprentissage
optimiseur <- torch::optim_adam(pmc$parameters)

Vérification - Valeur de départ de la perte.

#calcul de la sortie du réseau sur TRAIN
#on aurait pu écrire pmc(ts_ZTrain) 
proba <- pmc$forward(ts_ZTrain)
proba[1:10]

## torch_tensor
##  0.4064
##  0.4198
##  0.4038
##  0.3935
##  0.4003
##  0.4064
##  0.4097
##  0.4064
##  0.4064
##  0.4043
## [ CPUFloatType{10,1} ][ grad_fn = <SliceBackward0> ]

#attention dim. de proba
#qui est une matrice
dim(proba)

## [1] 399   1

#perte initiale sur TRAIN
critere(proba[,1],ts_yTrain)

## torch_tensor
## 0.228081
## [ CPUFloatType{} ][ grad_fn = <MseLossBackward0> ]

Processus d’apprentissage

#processus d'apprentissage
n_epochs <- 5000

#vecteur pour stocker la perte
losses <- rep(0,n_epochs)

#processus d'apprentissage
for (iter in 1:n_epochs){
  #ràz du gradient
  optimiseur$zero_grad()
  #calculer la sortie du réseau
  out_nn <- pmc$forward(ts_ZTrain)
  #calcul de la perte
  perte <- critere(out_nn[,1],ts_yTrain)
  #collecter la perte
  losses[iter] <- perte$item()
  #gradient + rétropropagation
  perte$backward()
  #mise à jour des coefs. (poids)
  optimiseur$step()
}

#
print("première valeur de perte")

## [1] "première valeur de perte"

print(losses[1])

## [1] 0.2280814

#
print("dernière valeur")

## [1] "dernière valeur"

print(losses[length(losses)-1])

## [1] 0.03522312

#graphique avec la décroissance de la perte
plot(1:n_epochs,losses,type="l",main="Decroissance perte")

Evaluation en test

Chargement et préparation de TEST.

#chargement éch. test
DTest <- readxl::read_excel("breast_test.xlsx")
str(DTest)

## tibble [300 × 7] (S3: tbl_df/tbl/data.frame)
##  $ ucellsize : num [1:300] 1 10 1 2 1 1 10 1 1 10 ...
##  $ ucellshape: num [1:300] 3 4 1 2 1 1 9 2 1 8 ...
##  $ mgadhesion: num [1:300] 1 7 1 1 1 1 3 1 1 8 ...
##  $ sepics    : num [1:300] 1 3 2 2 2 2 7 2 2 4 ...
##  $ normnucl  : num [1:300] 1 10 1 1 1 1 5 1 1 7 ...
##  $ mitoses   : num [1:300] 1 1 1 1 1 1 1 1 1 1 ...
##  $ classe    : chr [1:300] "begnin" "malignant" "begnin" "begnin" ...

#isoler les descripteurs
XTest <- DTest[,colnames(DTest)!="classe"]
str(XTest)

## tibble [300 × 6] (S3: tbl_df/tbl/data.frame)
##  $ ucellsize : num [1:300] 1 10 1 2 1 1 10 1 1 10 ...
##  $ ucellshape: num [1:300] 3 4 1 2 1 1 9 2 1 8 ...
##  $ mgadhesion: num [1:300] 1 7 1 1 1 1 3 1 1 8 ...
##  $ sepics    : num [1:300] 1 3 2 2 2 2 7 2 2 4 ...
##  $ normnucl  : num [1:300] 1 10 1 1 1 1 5 1 1 7 ...
##  $ mitoses   : num [1:300] 1 1 1 1 1 1 1 1 1 1 ...

Standardisation, attention avec les paramètres (moyennes, écarts-type) calculés sur l’échantillon d’apprentissage.

#valeurs des les paramètres (moyenne, sd)
#calculés sur le train
attributes(ZTrain)

## $dim
## [1] 399   6
## 
## $dimnames
## $dimnames[[1]]
## NULL
## 
## $dimnames[[2]]
## [1] "ucellsize"  "ucellshape" "mgadhesion" "sepics"     "normnucl"  
## [6] "mitoses"   
## 
## 
## $`scaled:center`
##  ucellsize ucellshape mgadhesion     sepics   normnucl    mitoses 
##   3.040100   3.185464   2.674185   3.115288   2.799499   1.498747 
## 
## $`scaled:scale`
##  ucellsize ucellshape mgadhesion     sepics   normnucl    mitoses 
##   3.003916   2.966427   2.801491   2.172635   3.055582   1.588075

#centrage-réduction
ZTest <- scale(XTest,
               center=attr(ZTrain,"scaled:center"),
               scale=attr(ZTrain,"scaled:scale"))

#premières valeurs
ZTest[1:5,]

##       ucellsize ucellshape mgadhesion      sepics   normnucl    mitoses
## [1,] -0.6791468 -0.0625209 -0.5976051 -0.97360489 -0.5889217 -0.3140574
## [2,]  2.3169419  0.2745850  1.5441115 -0.05306377  2.3565071 -0.3140574
## [3,] -0.6791468 -0.7367327 -0.5976051 -0.51333433 -0.5889217 -0.3140574
## [4,] -0.3462481 -0.3996268 -0.5976051 -0.51333433 -0.5889217 -0.3140574
## [5,] -0.6791468 -0.7367327 -0.5976051 -0.51333433 -0.5889217 -0.3140574

#transformation en tensor
ts_ZTest <- torch::torch_tensor(ZTest)
ts_ZTest[1:5,]

## torch_tensor
## -0.6791 -0.0625 -0.5976 -0.9736 -0.5889 -0.3141
##  2.3169  0.2746  1.5441 -0.0531  2.3565 -0.3141
## -0.6791 -0.7367 -0.5976 -0.5133 -0.5889 -0.3141
## -0.3462 -0.3996 -0.5976 -0.5133 -0.5889 -0.3141
## -0.6791 -0.7367 -0.5976 -0.5133 -0.5889 -0.3141
## [ CPUFloatType{5,6} ]

Application du modèle sur l’échantillon test, calcul des probabilités d’affectation.

#appliquer le modèle
ts_Proba <- pmc$forward(ts_ZTest)[,1]
ts_Proba[1:5]

## torch_tensor
##  0.0391
##  0.9252
##  0.0328
##  0.0459
##  0.0328
## [ CPUFloatType{5} ][ grad_fn = <SliceBackward0> ]

#transformer en vecteur numérique
#que sait manipuler R directement
proba <- as.numeric(ts_Proba$detach())
proba[1:5]

## [1] 0.03914410 0.92521733 0.03280917 0.04585509 0.03280917

#transformer la proba en affectation
pred <- c("begnin","malignant")[(proba > 0.5)+1]
pred[1:5]

## [1] "begnin"    "malignant" "begnin"    "begnin"    "begnin"

#matrice de confusion
mc <- table(DTest$classe,pred)
print(mc)

##            pred
##             begnin malignant
##   begnin       184         7
##   malignant      3       106

#accuracy
sum(diag(mc))/sum(mc)

## [1] 0.9666667

Représentation intermédiaire de la couche cachée

#représentation intermédiaire
#calcul des coordonnées des individus
ts_hidden <- pmc$forward_1(ts_ZTest)
ts_hidden[1:5,]

## torch_tensor
##  0.0614  0.9501
##  0.9988  0.0008
##  0.0220  0.9720
##  0.0813  0.9160
##  0.0220  0.9720
## [ CPUFloatType{5,2} ][ grad_fn = <SliceBackward0> ]

#en matrice de réels
#que R sait manipuler
hidden <- matrix(as.numeric(ts_hidden$detach()),nrow=nrow(DTest),ncol=2)
hidden[1:5,]

##            [,1]         [,2]
## [1,] 0.06137284 0.9501124024
## [2,] 0.99875331 0.0008215162
## [3,] 0.02204886 0.9719660878
## [4,] 0.08126422 0.9160339236
## [5,] 0.02204886 0.9719660878

#affichage dans le plan
plot(hidden[,1],hidden[,2],pch=16,cex=0.7,col=c("red","blue")[(DTest$classe=="malignant")+1])
legend(x=0,y=0.6,legend=c("begnin","malignant"),fill=c("red","blue"),cex=0.7)

#poids et intercept de la jonction
#cachée -> sortie : séparateur linéaire
#on peut utiliser ces infos pour tracer la frontière
print("Coef.")

## [1] "Coef."

print(pmc$layer_2$weight)

## torch_tensor
##  2.9037 -3.1541
## [ CPUFloatType{1,2} ][ requires_grad = TRUE ]

print("Intercept")

## [1] "Intercept"

pmc$layer_2$bias

## torch_tensor
## -0.3820
## [ CPUFloatType{1} ][ requires_grad = TRUE ]