Objetivo: Criar um script de aumento de dados com imagens numéricas.

O banco de dados será aumentado tanto nas linhas como nas colunas e o número utilizado foi o 3 do link https://www.magazineluiza.com.br/numero-acrilico-kami-4cm-n-3-preto-/p/gjh7140f84/cj/lenu/.

suppressMessages(suppressWarnings(library(magick)))
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.2.1     ✔ purrr   0.3.3
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   1.0.0     ✔ 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()
#Utilizaremos a imagem 3
img <- image_read("b68d9c9c25b8e1b896c2d743b72fce5b.jpg")
plot(img)

Vale ressaltar que a imagem do dataset do digíto possui dimensões 28x28. Sendo assim, temos que transformar essa imagem também.

img <- image_read("b68d9c9c25b8e1b896c2d743b72fce5b.jpg") %>% 
  image_scale(geometry = 28) %>% 
  image_data(channels = "gray") %>% 
  .[1, , ] %>% 
  as.numeric() %>% 
  matrix(nrow = 28,ncol = 28,byrow = TRUE) %>% 
  apply(2,rev) %>% # Pra deixar em pé
  t()  

img %>% 
  image() # Serve pra plotar imagens em formato de matriz

Com o intuito de criar novas linhas e colunas, utilizaremos a transformada dct bidimensional. O principal ganho dela é que conseguiremos comprimir toda a informação contida na matriz p x p, nas coordenadas iniciais da matriz. Como estamos trabalhando a imagem de forma matricial, esse método é válido. Essa transformada pode ser considerada como uma rotação e o resultado que obtivemos é que os coeficientes mais significativos se encontram no canto superior esquerdo da matriz

#A transformada dct pode ser conseguida com o pacote mrbsizeR.
#A seguir a imagem com a transformada.

dct28 <- mrbsizeR::dctMatrix(28) 
aplica_dct <- function(x){
  x <- x/255
  q <- x %>% 
    matrix(28,28,byrow = T) %>% 
    apply(2,rev) %>% 
    t()
  q <- t(dct28)%*%q%*%dct28
  return( as.numeric(q) )
}

img %>% 
  aplica_dct() %>% 
  matrix(28,28,byrow = T) %>% 
  head()
##           [,1]       [,2]       [,3]        [,4]       [,5]       [,6]
## [1,] 17.344975 -0.7113484  6.1819367 -6.93694329  4.9912217 -0.6691782
## [2,] -6.208883  1.1819951 -0.7142470  1.09208560 -2.7627963  0.7663767
## [3,]  3.107309 -1.9353476  2.3208240  0.80371694  1.0350019 -0.6188391
## [4,] -2.665769  1.8030774 -1.5048464 -0.02279163 -0.1372393 -0.7098869
## [5,]  1.635270 -0.6995125  2.7780584 -0.21414846 -1.8330002 -0.2139022
## [6,] -2.522350  0.3053132  0.8423206  0.29935258 -0.8213911  0.7894914
##             [,7]        [,8]       [,9]      [,10]       [,11]       [,12]
## [1,]  0.10431735 -0.91610114  1.5954493 -1.0423805  1.41059017 -0.82574221
## [2,] -0.01768755  0.06353088 -0.1880328  0.5551015 -0.16682912  0.03936304
## [3,] -0.20333935 -0.48923067  0.2958523 -0.4370136  0.27712013  0.10565914
## [4,]  0.08411310  0.95706506 -0.5034799  0.2040003 -0.07558856  0.04900201
## [5,]  1.15895648 -0.41332624  0.1915197  0.1893197  0.19837807 -0.10421295
## [6,] -0.13813845 -0.09804994  0.1377236 -0.5341084 -0.13237324  0.43368934
##            [,13]       [,14]       [,15]       [,16]        [,17]
## [1,]  1.36817686 -0.20128718  0.57337127 -0.17440240  0.734651433
## [2,] -0.62608641  0.46490109 -0.47762191 -0.30935790 -0.003507247
## [3,]  0.20421507 -0.11284128  0.25539452  0.10514471  0.198700880
## [4,] -0.04016985 -0.34951092 -0.05721162  0.26261288 -0.367079994
## [5,] -0.18428418 -0.05721587  0.30227499 -0.19942019  0.085229846
## [6,] -0.51787159  0.06701756  0.29523688 -0.03114879 -0.013277314
##            [,18]        [,19]        [,20]       [,21]         [,22]
## [1,] -0.26038913  0.725867351 -0.117963343  0.60737792  0.0530181392
## [2,]  0.05909461 -0.281670789  0.068670703 -0.07937843  0.1642788919
## [3,] -0.16326539  0.169745189 -0.002854848 -0.02413817  0.0006045842
## [4,]  0.06298578  0.046318392  0.024097129 -0.07407840 -0.0963722631
## [5,]  0.13144525  0.034493920  0.011896069  0.06100675 -0.0598587991
## [6,]  0.02910906 -0.003614763  0.033678055 -0.26881759 -0.0515179374
##            [,23]        [,24]       [,25]       [,26]        [,27]
## [1,]  0.36549872  0.128555485  0.41156488  0.14444771  0.360018834
## [2,] -0.29622375 -0.044524366  0.02900059 -0.20054462 -0.164562777
## [3,]  0.13830478 -0.006092971  0.02897013  0.03292452  0.151479077
## [4,]  0.09050070 -0.010170284 -0.20237838  0.08264795 -0.027803536
## [5,]  0.08367060 -0.003782498  0.06380678  0.07666600 -0.006649839
## [6,]  0.03549683 -0.063733735 -0.04141072  0.05823588  0.045080293
##            [,28]
## [1,]  0.24983506
## [2,] -0.03266027
## [3,]  0.06355993
## [4,] -0.08401655
## [5,]  0.02144113
## [6,] -0.05957127
# Imagem
img %>% 
  aplica_dct() %>% 
  matrix(28,28,byrow = T) %>% 
  apply(2,rev) %>% 
  t() %>% 
  image()

Veja que o maior coeficiente é o elemento [1,1] da matriz com transformação, como era de se esperar.

#Aplicando o dct na base de dados
train <- read.csv("/opt/datasets/digits/train.csv")

set.seed(13092019)

x_train <- train %>% 
  select(-label) %>% 
  mutate_all(function(x) x/255) %>% 
  as.matrix()

# Aplicando na base de treino
x_train_transf <- x_train %>% 
  apply(1,aplica_dct) %>% 
  t()