1. Importer les données

library(kernlab)
data(spam)
library(keras)
spamX <- as.matrix(spam[,-58])
spamY <- to_categorical(as.numeric(spam$type)-1, 2)
set.seed(5678)
perm <- sample(4601,3000)
appX <- spamX[perm,]
appY <- spamY[perm,]
validX <- spamX[-perm,]
validY <- spamY[-perm,]

2. Construire un réseau et optimiser les paramètres

use_session_with_seed(42)
mod.1couche <- keras_model_sequential() %>%
  layer_dense(units=2, activation ="softmax")
mod.1couche %>% compile(loss = "categorical_crossentropy",
                        optimizer=optimizer_rmsprop(),metrics=c("accuracy"))
hist.1couche <- mod.1couche %>%
  fit(appX,appY,epochs=30,validation_split=0.2)
plot(hist.1couche)

hist.1couche <- mod.1couche %>%
  fit(appX,appY,epochs=30,validation_split=0)
mod.2couches <- keras_model_sequential() %>%
  layer_dense(units=30, activation ="relu") %>%
  layer_dense(units=2, activation ="softmax")
mod.2couches %>% compile(loss = "categorical_crossentropy",
                         optimizer=optimizer_rmsprop(),metrics=c("accuracy"))
hist.2couches <- mod.2couches %>%
  fit(appX,appY,epochs=30,validation_split=0)

3. Faire de la prévision

predict(mod.1couche, validX)[1:3,]
             [,1]      [,2]
[1,] 1.236067e-02 0.9876394
[2,] 1.891615e-01 0.8108385
[3,] 4.253551e-06 0.9999957
apply(predict(mod.1couche, validX), 1, which.max)[1:3]
[1] 2 2 2
predict(mod.2couches, validX)[1:3,]
             [,1]      [,2]
[1,] 8.853301e-05 0.9999114
[2,] 2.073462e-01 0.7926539
[3,] 1.384717e-05 0.9999862
apply(predict(mod.2couches, validX), 1, which.max)[1:3]
[1] 2 2 2

4. Sélectionner les caractéristiques d’un réseau

library(caret)
app <- spam[perm, ]
valid <- spam[-perm, ]
param_grid <- expand.grid(size = c(15, 30, 45), lambda = 0,
                          batch_size = 32, lr = 0.001, rho = 0.9,
                          decay = 0, activation = c("relu", "tanh"))
caret_mlp <- train(type ~ . , data = spam,
                   method = "mlpKerasDecay",
                   tuneGrid = param_grid,
                   epoch = 30, verbose = 0,
                   trControl = trainControl(method="cv",number=5))
caret_mlp
Multilayer Perceptron Network with Weight Decay 

4601 samples
  57 predictor
   2 classes: 'nonspam', 'spam' 

No pre-processing
Resampling: Cross-Validated (5 fold) 
Summary of sample sizes: 3681, 3681, 3682, 3680, 3680 
Resampling results across tuning parameters:

  size  activation  Accuracy   Kappa    
  15    relu        0.9280649  0.8486026
  15    tanh        0.9321859  0.8575659
  30    relu        0.9226377  0.8364300
  30    tanh        0.9347948  0.8642556
  45    relu        0.9304529  0.8536907
  45    tanh        0.9330616  0.8609232

Tuning parameter 'lambda' was held constant at a value of 0
Tuning parameter 'batch_size' was held constant at a
 value of 32
Tuning parameter 'lr' was held constant at a value of 0.001
Tuning parameter 'rho' was held constant at
 a value of 0.9
Tuning parameter 'decay' was held constant at a value of 0
Accuracy was used to select the optimal model using the largest value.
The final values used for the model were size = 30, lambda = 0, batch_size = 32, lr = 0.001, rho = 0.9, decay = 0
 and activation = tanh.
predict(caret_mlp, newdata = spam[1:3,])
[1] spam spam spam
Levels: nonspam spam

5. Estimer les performances du réseau

mean(predict(caret_mlp, newdata = valid)==valid[["type"]])
[1] 0.948782
LS0tDQp0aXRsZTogIlLDqXNlYXUgZGUgbmV1cm9uZXMiDQphdXRob3I6ICJIdXNzb24gZXQgYWwuIg0KZGF0ZTogIjA5LzA5LzIwMTgiDQpvdXRwdXQ6IA0KICBodG1sX25vdGVib29rOg0KICAgIHRvYzogeWVzDQogICAgdG9jX2RlcHRoOiAzDQogICAgdG9jX2Zsb2F0OiB5ZXMNCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IHllcw0KICAgIHRvY19kZXB0aDogJzMnDQogICAgdG9jX2Zsb2F0OiB5ZXMNCg0KLS0tDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFLCBjYWNoZSA9IFRSVUUpDQpgYGANCg0KIyAxLiBJbXBvcnRlciBsZXMgZG9ubsOpZXMNCg0KYGBge3J9DQpsaWJyYXJ5KGtlcm5sYWIpDQpkYXRhKHNwYW0pDQpgYGANCg0KYGBge3IsbWVzc2FnZT1GQUxTRSx3YXJuaW5nPUZBTFNFfQ0KbGlicmFyeShrZXJhcykNCnNwYW1YIDwtIGFzLm1hdHJpeChzcGFtWywtNThdKQ0Kc3BhbVkgPC0gdG9fY2F0ZWdvcmljYWwoYXMubnVtZXJpYyhzcGFtJHR5cGUpLTEsIDIpDQpgYGANCg0KYGBge3IsbWVzc2FnZT1GQUxTRSx3YXJuaW5nPUZBTFNFfQ0Kc2V0LnNlZWQoNTY3OCkNCnBlcm0gPC0gc2FtcGxlKDQ2MDEsMzAwMCkNCmFwcFggPC0gc3BhbVhbcGVybSxdDQphcHBZIDwtIHNwYW1ZW3Blcm0sXQ0KdmFsaWRYIDwtIHNwYW1YWy1wZXJtLF0NCnZhbGlkWSA8LSBzcGFtWVstcGVybSxdDQpgYGANCg0KIyAyLiBDb25zdHJ1aXJlIHVuIHLDqXNlYXUgZXQgb3B0aW1pc2VyIGxlcyBwYXJhbcOodHJlcw0KDQpgYGB7cixtZXNzYWdlPUZBTFNFLHdhcm5pbmc9RkFMU0V9DQp1c2Vfc2Vzc2lvbl93aXRoX3NlZWQoNDIpDQptb2QuMWNvdWNoZSA8LSBrZXJhc19tb2RlbF9zZXF1ZW50aWFsKCkgJT4lDQogIGxheWVyX2RlbnNlKHVuaXRzPTIsIGFjdGl2YXRpb24gPSJzb2Z0bWF4IikNCmBgYA0KDQpgYGB7cixtZXNzYWdlPUZBTFNFLHdhcm5pbmc9RkFMU0V9DQptb2QuMWNvdWNoZSAlPiUgY29tcGlsZShsb3NzID0gImNhdGVnb3JpY2FsX2Nyb3NzZW50cm9weSIsDQogICAgICAgICAgICAgICAgICAgICAgICBvcHRpbWl6ZXI9b3B0aW1pemVyX3Jtc3Byb3AoKSxtZXRyaWNzPWMoImFjY3VyYWN5IikpDQpoaXN0LjFjb3VjaGUgPC0gbW9kLjFjb3VjaGUgJT4lDQogIGZpdChhcHBYLGFwcFksZXBvY2hzPTMwLHZhbGlkYXRpb25fc3BsaXQ9MC4yKQ0KYGBgDQoNCmBgYHtyfQ0KcGxvdChoaXN0LjFjb3VjaGUpDQpgYGANCg0KYGBge3IsbWVzc2FnZT1GQUxTRSx3YXJuaW5nPUZBTFNFfQ0KaGlzdC4xY291Y2hlIDwtIG1vZC4xY291Y2hlICU+JQ0KICBmaXQoYXBwWCxhcHBZLGVwb2Nocz0zMCx2YWxpZGF0aW9uX3NwbGl0PTApDQpgYGANCg0KYGBge3J9DQptb2QuMmNvdWNoZXMgPC0ga2VyYXNfbW9kZWxfc2VxdWVudGlhbCgpICU+JQ0KICBsYXllcl9kZW5zZSh1bml0cz0zMCwgYWN0aXZhdGlvbiA9InJlbHUiKSAlPiUNCiAgbGF5ZXJfZGVuc2UodW5pdHM9MiwgYWN0aXZhdGlvbiA9InNvZnRtYXgiKQ0KYGBgDQoNCmBgYHtyLG1lc3NhZ2U9RkFMU0Usd2FybmluZz1GQUxTRX0NCm1vZC4yY291Y2hlcyAlPiUgY29tcGlsZShsb3NzID0gImNhdGVnb3JpY2FsX2Nyb3NzZW50cm9weSIsDQogICAgICAgICAgICAgICAgICAgICAgICAgb3B0aW1pemVyPW9wdGltaXplcl9ybXNwcm9wKCksbWV0cmljcz1jKCJhY2N1cmFjeSIpKQ0KaGlzdC4yY291Y2hlcyA8LSBtb2QuMmNvdWNoZXMgJT4lDQogIGZpdChhcHBYLGFwcFksZXBvY2hzPTMwLHZhbGlkYXRpb25fc3BsaXQ9MCkNCmBgYA0KDQojIDMuIEZhaXJlIGRlIGxhIHByw6l2aXNpb24NCg0KYGBge3J9DQpwcmVkaWN0KG1vZC4xY291Y2hlLCB2YWxpZFgpWzE6MyxdDQphcHBseShwcmVkaWN0KG1vZC4xY291Y2hlLCB2YWxpZFgpLCAxLCB3aGljaC5tYXgpWzE6M10NCnByZWRpY3QobW9kLjJjb3VjaGVzLCB2YWxpZFgpWzE6MyxdDQphcHBseShwcmVkaWN0KG1vZC4yY291Y2hlcywgdmFsaWRYKSwgMSwgd2hpY2gubWF4KVsxOjNdDQpgYGANCg0KIyA0LiBTw6lsZWN0aW9ubmVyIGxlcyBjYXJhY3TDqXJpc3RpcXVlcyBk4oCZdW4gcsOpc2VhdQ0KDQpgYGB7cixtZXNzYWdlPUZBTFNFLHdhcm5pbmc9RkFMU0V9DQpsaWJyYXJ5KGNhcmV0KQ0KYXBwIDwtIHNwYW1bcGVybSwgXQ0KdmFsaWQgPC0gc3BhbVstcGVybSwgXQ0KcGFyYW1fZ3JpZCA8LSBleHBhbmQuZ3JpZChzaXplID0gYygxNSwgMzAsIDQ1KSwgbGFtYmRhID0gMCwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgYmF0Y2hfc2l6ZSA9IDMyLCBsciA9IDAuMDAxLCByaG8gPSAwLjksDQogICAgICAgICAgICAgICAgICAgICAgICAgIGRlY2F5ID0gMCwgYWN0aXZhdGlvbiA9IGMoInJlbHUiLCAidGFuaCIpKQ0KY2FyZXRfbWxwIDwtIHRyYWluKHR5cGUgfiAuICwgZGF0YSA9IHNwYW0sDQogICAgICAgICAgICAgICAgICAgbWV0aG9kID0gIm1scEtlcmFzRGVjYXkiLA0KICAgICAgICAgICAgICAgICAgIHR1bmVHcmlkID0gcGFyYW1fZ3JpZCwNCiAgICAgICAgICAgICAgICAgICBlcG9jaCA9IDMwLCB2ZXJib3NlID0gMCwNCiAgICAgICAgICAgICAgICAgICB0ckNvbnRyb2wgPSB0cmFpbkNvbnRyb2wobWV0aG9kPSJjdiIsbnVtYmVyPTUpKQ0KYGBgDQoNCmBgYHtyfQ0KY2FyZXRfbWxwDQpgYGANCg0KYGBge3J9DQpwcmVkaWN0KGNhcmV0X21scCwgbmV3ZGF0YSA9IHNwYW1bMTozLF0pDQpgYGANCg0KIyA1LiBFc3RpbWVyIGxlcyBwZXJmb3JtYW5jZXMgZHUgcsOpc2VhdQ0KDQpgYGB7cn0NCm1lYW4ocHJlZGljdChjYXJldF9tbHAsIG5ld2RhdGEgPSB2YWxpZCk9PXZhbGlkW1sidHlwZSJdXSkNCmBgYA0KDQo=