Relatório

Objetivo

Este relatório tem o objetivo de explicar como é possível utilizar RNN para treinar um modelo que antevê um número existente em uma imagem. Será utilizada a base de dados digit.recognizer disponível no site do Kaggle, por meio do link: https://www.kaggle.com/c/digit-recognizer/leaderboard.

Bibliotecas

A priori, carrega-se os pacotes necessários.

library(tidyverse)
## ── Attaching packages ────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.2.1     ✔ purrr   0.3.2
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   0.8.3     ✔ stringr 1.4.0
## ✔ readr   1.3.1     ✔ forcats 0.4.0
## ── Conflicts ───────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(keras)

Matriz de dados

Fixa-se as dimensões da matriz de dados e o número de classes da variável resposta.

# Constants
img_rows <- 28
img_cols <- 28
n_classes <- 10

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

Pode-se selecionar uma linha da base de dados e pode-se fazer transformações na matriz geradora de imagens. Isto é feito para visualizar a imagem e para que a mesma seja disposta na horizontal ou vertical, abaixo observa-se que a imagem está na vertical.

set.seed(1)
# Visualizing a random digit
train %>% 
  select(-label, -Flag) %>% 
  sample_n(1) %>%   
  unlist() %>%
  matrix(nrow = 28, byrow = TRUE) %>% 
  apply(2, rev) %>% 
  t() %>% 
  image() 

Através da função a seguir, é possível dispor vários números em escala de cinza.

# Start Function
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)
  }
  # Check graphical parameters 
  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)
  }
  # reset the original graphics parameters
  par(val)                                               
}

# Call Function
Label(101:120, train)
## 
## Removing label column...
## Removing Flag column...

## Removing label column...
## Removing Flag column...

Matrizes de treino e de teste

É necessário a criação das matrizes de teste e treino, pois nos modelos de redes neurais é preciso evidenciar tais matrizes usadas nos cálculos dos modelos.

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() %>% 
  keras::to_categorical(num_classes = 10)

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

Treinamento do modelo

Cria-se o objeto para treinamento do modelo e define-se o método de modelagem a ser utilizado.

rnn_model <- keras_model_sequential() 

Define-se os hiperparâmetros do modelo.

rnn_model %>% 
  layer_dense(units = 256, activation = 'relu', input_shape = c(img_cols*img_rows)) %>% 
  layer_dropout(rate = 0.4) %>% 
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = n_classes, activation = 'softmax')

Os modelos RNN são estimados por meio de camadas. O comando layer_dense define estas camadas. Abaixo a descrição de cada parâmetro.

  1. units: Informa o número de parâmetros;
  2. activation: Define qual será a função de ativação. Em redes neurais, a função de ativação é o meio utilizado para estimar os parâmetros de cada camada;
  3. input_shape: Informa o número das colunas da matriz X;
  4. layer_drop: Faz com que sejam desabilitadas algumas linhas da matriz de treinamento.

Neste caso, o número de parâmetros é 10 e a função de ativação é softmax. A função de ativação softmax gera estimativas no intervalo (0,1).

Em seguida, define-se a função de perda, o método de estimação e a métrica de performance através da função compile. Utiliza-se a entropia cruzada para variáveis categoricas na função de perda e o método RMSProp, na estimação dos parâmetros.

rnn_model %>% compile(
  loss = 'categorical_crossentropy', #categorical_accuracy
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)

O modelo já pode ser treinado.note que o processo a seguir está sendo salvo em um objeto. Tal objeto guardará o caminho de estimação do modelo para que seja possível ver a função de perda e a acúracia.

history <- rnn_model %>% fit(
  x_train, y_train, 
  epochs = 10, batch_size = 128, 
  validation_split = 0.2)

plot(history)   

Testando o modelo

Agora é possível ver a conformidade do modelo na base de testes. para isso, será utilizado a função evaluate gerando como argumentos a matriz de teste e a matriz de resposta.

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

Dispondo das matrizes de pesos das camadas e executando as operações matriciais, acarretará em fazer o mesmo que a função evaluate, porém de forma manual.

wgts <- get_weights(rnn_model)

class(wgts)
## [1] "list"
length(wgts)
## [1] 6
Input <- wgts[[1]]
dim(Input)
## [1] 784 256
Input_bias <- wgts[[2]]
Layer <- wgts[[3]]
Layer_bias <- wgts[[4]]
Output <- wgts[[5]]
Output_bias <- wgts[[6]]

Y = x_test[4039,] %*% Input + t(Input_bias)
Y_relu = Y * (Y > 0) # Activation Function if_else(Y > 0, Y, 0)
Z = Y_relu %*% Layer + t(Layer_bias)
Z_relu = Z * (Z > 0) # Activation Function
W = Z_relu %*% Output + t(Output_bias)
f_exp = exp(W)
W_softmax = f_exp/sum(f_exp)# softmax output


round(W_softmax,5)
##      [,1] [,2] [,3] [,4]  [,5] [,6] [,7] [,8] [,9]   [,10]
## [1,]    0    0    0    0 1e-05    0    0    0    0 0.99999

Observe que os outputs são probabilidades para cada digito. Aquele que deter a maior probabilidade será escolhido para a predição. Neste caso, o digito escolhido foi o 9.

Testando com dados reais

A partir de agora o modelo será averiguado quanto ao seu funcionamento utilizando dados reais.

###################Dando erro#################

#library(imager)

#digit <- load.image("digit.jpeg")
 # digit28 <- digit %>%  resize(size_x = 28, size_y = 28, interpolation_type = 1L)
  
#plot(digit,axes = FALSE)
#digit28 <- digit %>%  resize(size_x = 28, size_y = 28, interpolation_type = 1L)

#digit28 <- rowMeans(digit28, dims = 2)

#digit28 %>%
 # apply(1, rev) %>% 
  #t() %>% 
  #image(col = grey.colors(256), axes = FALSE)
# Deixando no intervalo [0,1]
#digit_test_2 <- digit28 %>%
 # apply(2,function(x) x/255) %>% 
  #apply(1, rev) %>% 
  #t() %>% 
  #as.vector()

# Prevendo
#Y = (1 - digit_test_2) %*% Input + t(Input_bias)
#Y_relu = Y * (Y > 0) # Activation Function
#Z = Y_relu %*% Layer + t(Layer_bias)
#Z_relu = Z * (Z > 0) # Activation Function
#W = Z_relu %*% Output + t(Output_bias)
#f_exp = exp(W)
#W_softmax = f_exp/sum(f_exp)# softmax output

#round(W_softmax, 5)