Esse trabalho visa tentar predizer a imagem de um nĂºmero, atravĂ©s da utilizaĂ§Ă£o de uma rede neural. Essa base de dados pode ser encontrada atravĂ©s do link do kaggle: https://www.kaggle.com/c/digit-recognizer/leaderboard.

Inicialmente, foi-se instalado os pacotes que irĂ¡ ser utilizado na atividade:

install.packages("tensorflow")
## Installing package into '/home/victor/R/x86_64-pc-linux-gnu-library/3.6'
## (as 'lib' is unspecified)
## Warning in install.packages("tensorflow"): installation of package
## 'tensorflow' had non-zero exit status
suppressMessages(suppressWarnings(library(tidyverse)))
library(readr)
library(keras)
library(imager)
## Loading required package: magrittr
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## Attaching package: 'imager'
## The following object is masked from 'package:magrittr':
## 
##     add
## The following object is masked from 'package:stringr':
## 
##     boundary
## The following object is masked from 'package:tidyr':
## 
##     fill
## The following objects are masked from 'package:stats':
## 
##     convolve, spectrum
## The following object is masked from 'package:graphics':
## 
##     frame
## The following object is masked from 'package:base':
## 
##     save.image
library(tensorflow)

Criando as bases de teste e treino, alĂ©m da variĂ¡vel Flag pra ambas citadas anteriormente.

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

test <- read_csv("/opt/datasets/digits/test.csv")
## Parsed with column specification:
## cols(
##   .default = col_double()
## )
## See spec(...) for full column specifications.
train <- read_csv("/opt/datasets/digits/train.csv")
## Parsed with column specification:
## cols(
##   .default = col_double()
## )
## See spec(...) for full column specifications.
test <- test %>% mutate(Flag = sample(c(0,1),
                                      size = nrow(test),
                                      replace = TRUE,
                                      prob = c(0.3,0.7)))

train <- train %>% mutate(Flag = sample(c(0,1),
                                        size = nrow(train),
                                        replace = TRUE,
                                        prob = c(0.7,0.3)))

Para visualizar a imagem, faremos:

set.seed(1)
# Visualizing a random digit
train %>% 
  select(-Flag) %>% 
  sample_n(1) %>%   
  unlist() %>%
  matrix(nrow = 28, byrow = TRUE) %>% 
  apply(2, rev) %>% 
  t() %>% 
  image() 
## Warning in matrix(., nrow = 28, byrow = TRUE): data length [785] is not a
## sub-multiple or multiple of the number of rows [28]

Querendo visualizar vĂ¡rias imagens numĂ©ricas ao mesmo tempo, faremos o cĂ³digo abaixo:

 # 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...

Criando as matrizes de treino e teste:

set.seed(123)

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)

Treinando o modelo, ficaremos:

rnn_model <- keras_model_sequential() 

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')

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

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

Resultados do modelo

rnn_model %>% evaluate(x_test, y_test)
## $loss
## [1] 0.09875573
## 
## $accuracy
## [1] 0.9713737
wgts <- get_weights(rnn_model)

Input <- wgts[[1]]

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.99952 2e-05 1e-05    0    0    0 0.00015 0.00029 1e-05

Obtemos uma acurĂ¡cia de 97% do modelo, valor bastante significante. Com 99% de probabilidade, o nĂºmero 8.