Proposta do Relatório

Reproduzir os códigos mostrados em sala de aula e apresentar os principais resultados da rede neural.

Base de dados e vizualização

A base de dados é dividida em amostra de treinamento e amostra de teste. A amostra de treinamento constitui de 42000 observações com 786 variáveis, sendo cada uma dessas variáveis um pixel de uma imagem. O treinamento, consiste em apresentar os dados ao algoritmo para que o aprendizado da maquina ocorra

Os pacotes utilizados foram os:

library(tidyverse)
library(keras)
# Constantes utilzada no modelo
img_rows <- 28
img_cols <- 28
n_classes <- 10

Os arquivos foram fornecidos, em formato rds.

test <- read_rds("test.rds")
label <- read_rds("label_test.rds")
train <- read_rds("train.rds")

Vizualizando um digito de forma aleatória.

train %>% 
  select(-label, -Flag) %>% 
  sample_n(1) %>%   
  unlist() %>%
  matrix(nrow = 28, byrow = TRUE) %>% 
  apply(2, rev) %>% 
  t() %>% 
  image() 

Fazendo outra função, afim de vizualizar mais de um digito, escolhendo eles de forma aleatória. Essa função consiste em plotar o intervalo de dígitos escolhido pelo usuários.

Label <- function(digits, base, nrows = 28, ncols = 28){
  stopifnot(digits %in% 1:nrow(base))
  if ("label" %in% colnames(base)) 
  {
    cat("\nRemoving label column...")
    base <- base %>%  select(-label)
  }
  if ("Flag" %in% colnames(base)) 
  {
    cat("\nRemoving Flag column...")
    base <- base %>%  select(-Flag)
  }
  #
  val <- par(no.readonly=TRUE)
  n <- ceiling(sqrt(length(digits)))
  par(mfrow = c(ceiling(length(digits)/n),n), mar = c(0.1, 0.1, 0.1, 0.1))
  for (i in digits){ 
    m <- base %>% 
      filter(row_number() == i) %>%  
      unlist() %>%
      matrix(nrow = nrows, ncol = ncols, byrow = TRUE) %>% 
      apply(2, rev) %>% 
      t() %>% 
    image(col = grey.colors(255), axes = FALSE)
  }
  # 
  par(val)                                               
}

#Chamando a função
Label(101:109, train)
## 
## Removing label column...
## Removing Flag column...

Rede Neural

Nessa seção, será mostrados os principais códigos utilizado para a formação da nossa primeira rede neural. O principal objetivo desse programa, é de conseguir identificar os dígitos fornecidos pelo banco de dados, ou seja, trata-se de um reconhecimento de imagem. A amostra de treinamento vai entrar em processo com o algoritmo e por fim, usaremos o modelo treinado para fazer essas classificações. Entregaremos ao modelo novas imagens (pela amostra de teste) e ele terá que classificar se a imagem é um dos dígitos de 1 a 9. O esperado no final, é que tenha o mais alto nível de acurácia possível.

#Definindo uma semente
set.seed(123) 

#Definindo uma nova amostra de treinamento, sendo os x representando os pixels
x_train <- train %>% 
  filter(Flag == 0) %>% 
  select(-label, -Flag) %>% 
  mutate_all(function(x) x/255) %>% 
  as.matrix()

x_test  <- train %>% 
  filter(Flag == 1) %>% 
  select(-label, -Flag) %>% 
  mutate_all(function(x) x/255) %>% 
  as.matrix()

y_train <- train %>% 
  filter(Flag == 0) %>% 
  select(label)  %>% as.matrix() %>% 
  to_categorical(num_classes = 10)

y_test <- train %>% 
  filter(Flag == 1) %>% 
  select(label)  %>% 
  as.matrix() %>% 
  to_categorical(num_classes = 10)

Após definir as nossas novas bases de treinamento e teste, finalmente, vamos entrar na parte de treinar a rede neural. Podemos observar que na primeira camada da rede neural, apresenta cerca de 1024 neurônios, totalizando com 803840 parâmetros. Na segunda camada, como pedido no algoritmo, apresenta 512 neurônios concluindo com 524800 parâmetros. Por final, na terceira e última camada foi aplicado 10 neurônios, restando 5130 parâmetros a serem estimados.

# Definindo o modelo com três camadas
rnn_model <- keras_model_sequential()
rnn_model %>%
  layer_dense(units = 1024, activation = 'relu', input_shape = c(img_cols*img_rows)) %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 512, activation = 'relu') %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = n_classes, activation = 'softmax')

summary(rnn_model)
## Model: "sequential"
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense (Dense)                    (None, 1024)                  803840      
## ___________________________________________________________________________
## dropout (Dropout)                (None, 1024)                  0           
## ___________________________________________________________________________
## dense_1 (Dense)                  (None, 512)                   524800      
## ___________________________________________________________________________
## dropout_1 (Dropout)              (None, 512)                   0           
## ___________________________________________________________________________
## dense_2 (Dense)                  (None, 10)                    5130        
## ===========================================================================
## Total params: 1,333,770
## Trainable params: 1,333,770
## Non-trainable params: 0
## ___________________________________________________________________________
rnn_model %>% compile(
  loss = 'categorical_crossentropy', 
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)

Podemos observar no gráfico abaixo, que ao longo da iterações, a acurácia do algoritmo sob treinameto aumenta, cada vez mais perto nos níveis da parte de validação. Ao longo do gráfico, é notável a presença de overfitting , isto é, quando uma função é muito próxima de um conjunto limitado de pontos de dados, ou em outras palavras, quando os erros das bases de treinamento e teste diferem discrepantemente.

# Treinando  e Avaliação
history <- rnn_model %>% fit(
  x_train, y_train,
  epochs = 20, batch_size = 128,
  validation_split = 0.2,
  callbacks = list(
    callback_early_stopping(monitor = "val_acc", min_delta = 0.001,
                            patience = 10,
                            verbose = 0,
                            mode = "auto",
                            restore_best_weights = TRUE))
)
plot(history)   

Com isso, foi obtido uma acurácia acima de 98% ou seja, o modelo conseguiu bons resultados na questão de identificação dos dígitos presente na base de dados.

# 
rnn_model %>% evaluate(x_test, y_test)
## $loss
## [1] 0.1549861
## 
## $acc
## [1] 0.9786122

Outra técnica a se utilizar na rede neural é de aumentar o número de camadas, afim de obter uma maior acurácia em relação a realização anterior. A função de ativação dessa nova camada é a relu. Esta função de ativação é mais utilizada ao projetar redes neurais atualmente. Nessa função relu, ela não permite a saída negativa, ou seja, se a entrada for negativa, ela será convertida em zero e o neurônio não será ativado. Isso significa que, ao mesmo tempo, apenas alguns neurônios são ativados, tornando a rede esparsa e eficiente e fácil para a computação.

# Definindo o modelo com quatro camadas
rnn_model <- keras_model_sequential() 
rnn_model %>%
  layer_dense(units = 1024, activation = 'relu', input_shape = c(img_cols*img_rows)) %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 512, activation = 'relu') %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = 256, activation = 'relu') %>%
  layer_dropout(rate = 0.125) %>%
  layer_dense(units = n_classes, activation = 'softmax')

summary(rnn_model)
## Model: "sequential_1"
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense_3 (Dense)                  (None, 1024)                  803840      
## ___________________________________________________________________________
## dropout_2 (Dropout)              (None, 1024)                  0           
## ___________________________________________________________________________
## dense_4 (Dense)                  (None, 512)                   524800      
## ___________________________________________________________________________
## dropout_3 (Dropout)              (None, 512)                   0           
## ___________________________________________________________________________
## dense_5 (Dense)                  (None, 256)                   131328      
## ___________________________________________________________________________
## dropout_4 (Dropout)              (None, 256)                   0           
## ___________________________________________________________________________
## dense_6 (Dense)                  (None, 10)                    2570        
## ===========================================================================
## Total params: 1,462,538
## Trainable params: 1,462,538
## Non-trainable params: 0
## ___________________________________________________________________________
rnn_model %>% compile(
  loss = 'categorical_crossentropy',
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)

Treinando novamente o modelo, houve uma pequena melhora na acurácia em relação a rede neural anterior, concluindo que o adicionalmente dessa nova camada foi bastante eficaz no aumento da acurácia, melhorando a capacidade de detectação do modelo. Na questão do overfitting, houve uma pequena melhora.

# Treinando  e Avaliação
history <- rnn_model %>% fit(
  x_train, y_train, 
  epochs = 20, batch_size = 128, 
  validation_split = 0.2 ,
  callbacks = list(
    callback_early_stopping(monitor = "val_acc", min_delta = 0.01,
                            patience = 10,
                            verbose = 0,
                            mode = "auto",
                            restore_best_weights = TRUE)))

plot(history)   

Apesar da pequena melhora ao adicionarmos uma nova camada na rede neural, não necessariamente o aumento da acurácia é ocasionado por causa disso, outros fatores também influenciam, como por exemplo a imagem gerada aleatóriamente, dependendo do número sorteado, uma rede neural pode ser mais eficaz que a outra.

#
rnn_model %>% evaluate(x_test, y_test)
## $loss
## [1] 0.1194053
## 
## $acc
## [1] 0.9693441