Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ---
- title: "Rendu Travaux Pratiques 5"
- author: "Joël ZHU"
- output:
- html_document: default
- html_notebook: default
- ---
- ** **
- #### Règles de rendu
- * Chaque TP donne lieu à un bref compte-rendu portant sur certaines questions posées dans l'énoncé du TPs.
- * Le compte-rendu doit être complété à partir du texte de l'énoncé. Les codes R doivent être inclus dans le texte du compte-rendu (menu **Insert**) et commentés avec précision. **Les commentaires compteront pour une part importante dans la note**.
- * Le compte-rendu doit être déposé **sur TEIDE à la date indiquée**. Les rendus en retard seront fortement pénalisés.
- * Le compte-rendu doit être déposé **sur TEIDE au format HTML uniquement**. Utiliser la fonction **Preview** ou **knitr** du menu de rstudio pour obtenir le document au format souhaité. **Les fichiers "source" (Rmd) ne seront pas acceptés par les correcteurs**.
- Le dépot comportera en plus du fichier intitulé "Rendu_TP5.html"
- - un "objet" R sauvé sous forme compressée contenant le modèle choisi pour être évalué par l'enseignant sur l'ensemble test. Le fichier compressé devra être sauvé sous le format RDS ou sous le format hdf5. Son intitulé devra être personnalisé sous la forme "my_login_bestmodel.RDS" ou "my_login_bestmodel.hdf5".
- - Un script R, contenant une fonction permettant d'évaluer le modèle.
- ** **
- ## Exercice : Défi analyse d'opinion (IMDB)
- ```{r}
- library(magrittr)
- library(keras)
- ```
- ```{r}
- # On récupère la base de donnée des mots imdb
- index <- keras::dataset_imdb_word_index()
- ```
- ```{r}
- # On range les mots en fonction de leur nombre d'utilisation en ordre croissant
- o <- as.numeric(index) %>% order()
- ```
- ```{r}
- # On garde seulement les 2000 termes les plus fréquents.
- imbd <- keras::dataset_imdb(path = "imdb.npz",
- num_words = 2048,
- skip_top = 48)
- ```
- ```{r}
- # On constitue un jeu de données avec 10000 documents choisis pour moitié dans l'ensemble "train" et pour moitié dans l'ensemble "test" de l'IMDB.
- x_imbd <- NULL
- for (i in 1:10){
- x_imbd_500 <- NULL
- for (j in (500*(i-1)+1):(500*i)){
- # Pour chaque document de l'ensemble train, on stocke les indices des mots constituant le document.
- doc_temp <- imbd$train$x[[j]]
- # Pour chaque document, on applique la fonction permettant d'indiquer le nombre d'apparition de chacun des indices.
- # On stocke ensuite cela dans x_imbd_500 (matrice).
- x_imbd_500 <- rbind(x_imbd_500,
- sapply(49:2048,
- FUN = function(ind) sum(doc_temp == ind)))
- }
- # On stocke dans x_imbd par tranche de 500
- x_imbd <- rbind(x_imbd, x_imbd_500)
- }
- for (i in 1:10){
- x_imbd_500 <- NULL
- for (j in (500*(i-1)+1):(500*i)){
- # On fait la même pour l'ensemble test.
- doc_temp <- imbd$test$x[[j]]
- # On continue de stocker tout ça dans x_imbd_500.
- x_imbd_500 <- rbind(x_imbd_500,
- sapply(49:2048,
- FUN = function(ind) sum(doc_temp == ind)))
- }
- # On stocke dans x_imbd par tranche de 500
- x_imbd <- rbind(x_imbd, x_imbd_500)
- }
- ```
- ```{r}
- # On représente les classes 0 et 1 sous forme matriciel.
- y_imbd <- to_categorical(imbd$train$y[1:5000], 2)
- y_imbd <- rbind(y_imbd, to_categorical(imbd$test$y[1:5000], 2))
- ```
- ```{r}
- # On garde tous les mots sauf le 2000ème.
- x <- x_imbd[,-2000]
- y <- y_imbd[,2]
- # On calcule le coefficient de correlation
- r2 <- cor(x,y)^2
- ```
- #### Analyse d'association
- * Dans quelles proportions les termes de valeur d'association $r^2$ supérieure à 0.02 apparaissent-ils dans les documents ? Représenter graphiquement ces proportions à l'aide d'un diagramme en barre.
- ```{r}
- # On prend les mots dont le coefficient de corrélation est supérieur 0.02. On calcule la fréquence avec mean.
- freq <- x[, (r2 > 0.02) ] %>% apply(2, mean)
- # On dessine le barplot
- # On réalise un décalage de 45 indices dans l'index pour trouver le codage correct
- names(freq) <- index[o[which(r2 > 0.02) + 45]] %>% names()
- barplot(sort(freq, decreasing = TRUE), col = "lightblue", las = 2)
- ```
- * Dans quelles proportions les termes de valeur d'association $r^2$ supérieure à 0.02 apparaissent-ils dans les documents **à connotation positive** ? Représenter graphiquement ces proportions à l'aide d'un diagramme en barre.
- ```{r}
- # Les documents à connotation positive sont associé à '1', donc on calcule la fréquence des mots pour les films avec un avis positif seulement (y == 1).
- freq <- x[y==1, (r2 > 0.02)] %>% apply(2, mean)
- # On dessine le barplot
- # On réalise un décalage de 45 indices dans l'index pour trouver le codage correct
- names(freq) <- index[o[which(r2 > 0.02) + 45]] %>% names()
- barplot(sort(freq, decreasing = TRUE), col = "lightblue", las = 2)
- ```
- #### Modèles de prédiction
- * \`A l'aide des outils vus dans les séances précédentes, tels que `keras`, (_lda_, _nnet_, ou d'autres bibliothèques de programmes que vous pourriez trouver dans R), ajuster des modèles d'apprentissage aux données contenues dans le TP : `x_imbd` et `y_imbd`.
- * Dans un tableau, décrire les performances de 6 méthodes choisies pour des échantillons d'apprentissage et de test que vous aurez créés vous-mêmes à partir des objets `x_imbd` et `y_imbd`. Les performances seront mesurées par les erreurs de classification et d'entropie (perte log loss).
- ```{r}
- # initialisation pour le tableau
- acc <- NULL
- loss <- NULL
- name <- NULL
- ```
- ```{r}
- # index_train correspond à la séparation entre les données de test et les données train (train correspondent aux données de 0 à 5000 et test de 5001 à 10000).
- index_train = 0:5000
- # Création des ensembles de train et de test
- x_train <- x_imbd[index_train,]
- y_train <- y_imbd[index_train,]
- x_test <- x_imbd[-index_train,]
- y_test <- y_imbd[-index_train,]
- ```
- ```{r}
- # keras 1_10_2
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 10, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.2) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_1_10_2')
- ```
- ```{r}
- # keras 2_1000_2
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 1000, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.2) %>%
- layer_dense(units = 1000, activation = 'relu') %>%
- layer_dropout(rate = 0.2) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_2_1000_2')
- ```
- ```{r}
- # keras 2_5000_10
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 5000, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 1) %>%
- layer_dense(units = 5000, activation = 'relu') %>%
- layer_dropout(rate = 1) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_2_5000_10')
- ```
- ```{r}
- # keras 3_2000_5
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 2000, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 2000, activation = 'relu') %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 2000, activation = 'relu') %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_3_2000_5')
- ```
- ```{r}
- # keras 2_100_2
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 100, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.2) %>%
- layer_dense(units = 100, activation = 'relu') %>%
- layer_dropout(rate = 0.2) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_2_100_2')
- ```
- ```{r}
- # keras 2_1000_5
- # meilleur modèle
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 1000, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 1000, activation = 'relu') %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_2_1000_5')
- ```
- ```{r}
- # Affichage du tableau
- data.frame(name, acc, loss)
- ```
- * Donner le code R correspondant au meilleur modèle que vous avez ajusté (chunck ci-dessous). On considèrera la graine du générateur aléatoire comme un hyperparamètre supplémentaire du modèle.
- ```{r}
- # keras 2_1000_5
- # meilleur modèle
- # On crée le réseau
- model <- keras_model_sequential()
- model %>%
- layer_dense(units = 1000, activation = 'relu', input_shape = 2000) %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 1000, activation = 'relu') %>%
- layer_dropout(rate = 0.5) %>%
- layer_dense(units = 3, activation = 'softmax')
- # On définit les paramètres à optimiser
- model %>% compile(
- loss = 'sparse_categorical_crossentropy',
- optimizer = optimizer_rmsprop(lr = 0.001, decay = 0.1),
- metrics = c('accuracy')
- )
- # On entraîne le réseau et on le stocke l'historique dans une variable
- history <- model %>% fit(
- x_train,
- y_train[,1],
- epochs = 20,
- batch_size = 100,
- validation_split = 0.2
- )
- # On stocke les données sur la précision et le logloss dans une variable à chaque fois
- res = model %>% evaluate(x_test, y_test[,1])
- acc = c(acc, res$acc)
- loss = c(loss, res$loss)
- name = c(name, 'keras_2_1000_5')
- ```
- * Sauver votre meilleur modèle dans un format compressé (RDS ou HDF5 pour keras). Remplacer la chaîne de caractère "my_login" par votre propre login ensimag.
- ```{r eval = FALSE}
- # On sauvegarde le meilleur modèle en RDS
- saveRDS(model, file = "zhujo_model.RDS")
- # On sauvegarde le meilleur modèle en HDF5
- save_model_hdf5(object = model, filepath = "zhujo_keras.hdf5")
- ```
- * Ecrire et appliquer une fonction appelée "prediction_finale" pouvant prendre par défaut en entrée une matrice appelée "x_ultime" de taille 5000 lignes et 2000 colonnes contenant des valeurs binaires et une matrice "y_ultime" de taille 5000 lignes et 2 colonnes contenant des valeurs binaires. Cette fonction devra prédire les classes contenues dans "y_ultime" à partir des données "x_ultime" en chargeant le modèle que vous aurez choisi pour le défi. Elle calculera les taux de classification et la perte log loss pour l'ensemble considéré.
- **Exemple :**
- ```{r, eval = FALSE}
- prediction_finale <- function(x_ultime,
- y_ultime,
- file_path = "zhujo_model_keras.hdf5"){
- #Remplacer "my_login" par votre propre login ensimag.
- require(magrittr)
- #tests
- if (nrow(x_ultime) != 5000 | ncol(x_ultime) != 2000)
- stop("Dimensions de x incorrectes.")
- if (nrow(y_ultime) != 5000 | ncol(y_ultime) != 2)
- stop("Dimensions de y incorrectes.")
- #if keras
- require(keras)
- model <- load_model_hdf5(filepath = file_path)
- model %>% evaluate(x_ultime, y_ultime[,1])
- }
- ```
- ```{r eval = FALSE}
- prediction_finale(x_test, y_test)
- ```
- * Joindre un script R contenant la fonction `prediction_finale()` préalablement testée par vos soin.
- * Ne pas oublier la version htlm de ce compte rendu. Archiver et déposer l'ensemble dans TEIDE.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement