Severstal

Este relatório mostra como foi feita a manipulação e treinamento de uma rede neural convolucional para dados de imagens referente a disciplina de redes neurais para graduação do departamento de estatística da UFPE. O dataset utilizado para esta aplicação encontra-se no Kaggle e está relacionado a competição Severstal: Steel Defect Detection. O problema desta competição é: Detectar se uma barra de aço possui algum defeito, e caso seja encontrado, identificar qual defeito é esse.

Por conta do volume de dados ser muito grande e consequentemente a necessidade de um hardware mais potente, o relatório irá se ater a manipulação das imagens e a parte de treinamento do modelo será somente ilustrativa e para a primeira etapa de modelagem que é identificar se a imagem possui defeito.

Carregando os dados

train <- readr::read_csv("/opt/datasets/steel/train.csv")

## Parsed with column specification:
## cols(
##   ImageId_ClassId = col_character(),
##   EncodedPixels = col_character()
## )

head(train)

## # A tibble: 6 x 2
##   ImageId_ClassId EncodedPixels                                            
##   <chr>           <chr>                                                    
## 1 0002cc93b.jpg_1 29102 12 29346 24 29602 24 29858 24 30114 24 30370 24 30…
## 2 0002cc93b.jpg_2 <NA>                                                     
## 3 0002cc93b.jpg_3 <NA>                                                     
## 4 0002cc93b.jpg_4 <NA>                                                     
## 5 00031f466.jpg_1 <NA>                                                     
## 6 00031f466.jpg_2 <NA>

# ------- The packages ------- #
suppressMessages(suppressWarnings(require(tidyverse)))
suppressMessages(suppressWarnings(require(imager)))
suppressMessages(suppressWarnings(require(keras)))
# ---------------------------- #

# Lista com o local de todas as imagens
path_images <- list.files(path = "/opt/datasets/steel/train_images_dir",
                          pattern = ".jpg",recursive = TRUE,full.names = TRUE)
head(path_images)

## [1] "/opt/datasets/steel/train_images_dir/0002cc93b.jpg"
## [2] "/opt/datasets/steel/train_images_dir/00031f466.jpg"
## [3] "/opt/datasets/steel/train_images_dir/000418bfc.jpg"
## [4] "/opt/datasets/steel/train_images_dir/000789191.jpg"
## [5] "/opt/datasets/steel/train_images_dir/0007a71bf.jpg"
## [6] "/opt/datasets/steel/train_images_dir/000a4bcdd.jpg"

img_test <- imager::load.image(path_images[1])

print(img_test)

## Image. Width: 1600 pix Height: 256 pix Depth: 1 Colour channels: 3

plot(img_test,axes = T)

Veja que a imagem carregada tem resolucao 256x1600. Isso é importante na hora de treinar o modelo para implementar o array.

Criando a mascará que identifica o erro na imagem

Agora, vamos carregar os dados que se referem as máscaras que indicam, caso haja defeito em alguma imagem, onde este defeito se encontra. Vamos fazer um exemplo com uma imagem primeiro.

# Separando a coluna 1 em duas colunas
# 1.1 = ID
# 1.2 = TARGET

train <- train %>% 
  separate(ImageId_ClassId,into = c("id","tg"),sep = "_")


# Criando os poligonos de contorno de cada erro
pixels_to_split <- train$EncodedPixels[1]
splitted_pixels <- str_split(pixels_to_split, "[:space:]") %>% # splits the EncodedPixel observation using :space: character as a pattern
  unlist() %>% # unlists/as.vector the result of str_split
  as.numeric() %>% # the valus are still characters, so we transform them into numerical values
  matrix(ncol = 2, byrow = TRUE) %>%  # create a matrix of 2 columns with the values
  as_tibble() %>% # transform the matrix into a data.frame
  rename(pixel_start = V1, run_length = V2) %>% # rename the columns
  mutate(pixel_end = pixel_start + run_length) # create a variable pixel_end

## Warning: `as_tibble.matrix()` requires a matrix with column names or a `.name_repair` argument. Using compatibility `.name_repair`.
## This warning is displayed once per session.

height <- dim(img_test)[2]
width <- dim(img_test)[1]
mask <- matrix(0, nrow = height, ncol = width)
activated_pixels <- purrr::pmap(splitted_pixels, ~ seq(..1, ..3, by=1) ) %>% unlist()
mask[activated_pixels] <- 1
plot(img_test)
t(mask) %>% as.cimg() %>% as.pixset() %>% highlight(col="red")

Agora, vamos automatizar o processo. Vale frizar que existem imagens com 1 ou mais erros. A função a ser criada possui como entrada o id da imagem que se quer plotar. A função a seguir também utiliza um objeto global, ou seja, você deve ter executado o script até aqui para que funcione corretamente. Além disso, a função possui um argumento chamado only.mask, caso seja TRUE, ele irá plotar somente a(s) máscara(s). Por default, only.mask = TRUE.

# Vamos automatizar esse trocooo

split_pixels <- function(id,tg,x){
  n <- length(id)
  res <- data.frame()
  for(i in 1:n){
    aux <- data.frame(id = as.character(id[i]),
                      tg = as.character(tg[i]),
                      x[i] %>% 
                        str_split("[:space:]") %>% # splits the EncodedPixel observation using :space: character as a pattern
                        unlist() %>% # unlists/as.vector the result of str_split
                        as.numeric() %>% # the valus are still characters, so we transform them into numerical values
                        matrix(ncol = 2, byrow = TRUE) %>%  # create a matrix of 2 columns with the values
                        as_tibble() %>% # transform the matrix into a data.frame
                        rename(pixel_start = V1, run_length = V2) %>% # rename the columns
                        mutate(pixel_end = pixel_start + run_length) %>% 
                        return())
    res <- rbind.data.frame(res,aux)
  }
  return(res)
}


train_masks <- train[1:2,] %>% 
  na.omit() %>% 
  pmap_dfr(.f = ~split_pixels(..1,..2,..3))

Agora vamos criar a função para plotar os defeitos. (A hora da verdade !)

plot_img_with_masks <- function(d,Id,only_mask = FALSE){
  
  img <- imager::load.image(path_images[which(str_detect(path_images,Id))])

  Tg <- names(table(d$tg[d$id==Id]))
  
  masks <- list()
  
  dimensions <- dim(img)
  
  for(i in 1:length(Tg)){
    
    mask <- matrix(0, ncol = dimensions[1],  nrow = dimensions[2])
    
    activated_pixels <- d %>%
      dplyr::filter((id==Id)&(tg==Tg[i])) %>%
      dplyr::select(-id,-tg) %>%
      purrr::pmap(~ seq(..1, ..3, by = 1) ) %>%
      unlist()
    
    mask[activated_pixels] <- 1
    
    masks[[i]] <- mask
  } 
  
  if(only_mask==FALSE){
    plot(img,axes = FALSE)
  }
  else{
    par(mfrow = c(3,1))
    plot(img,axes = FALSE)
  
  }
  
  pal <- c("white","#33a02c","#ff7f00","#313695")
  
  for(i in 1:length(Tg)){
    
    if(only_mask==FALSE){
      t(masks[[i]]) %>%
        as.cimg() %>%
        as.pixset() %>%
        highlight(col = pal[as.numeric(Tg[i])] , lwd = 2.5)
      
      if(i==length(Tg)){
                    
  cat("-------------\n")
  cat("   Legend\n")
  cat("-------------\n")
  print(data.frame(Colour = c("White","Green","Orange","Blue"),
                   Target = c(1:4)) %>% 
          filter(Target%in%Tg))
  cat("-------------")
      }

    }
    else{
      plot(as.cimg(t(masks[[i]])),axes = FALSE)
    }
    
   }

  
}

train_masks %>% 
  plot_img_with_masks(Id = "41411378e.jpg")

## -------------
##    Legend
## -------------
##   Colour Target
## 1 Orange      3
## 2   Blue      4
## -------------

train_masks %>% 
  plot_img_with_masks(Id = "41411378e.jpg",only_mask = TRUE)

Preparação dos dados para modelagem

Agora vamos preparar o banco de dados para modelagem. Antes, uma singela tabela de frequências com o número de defeitos de cada espécies contidas no banco.

# Total de defeitos gerais
train %>% 
  mutate(tem_erro = is.na(EncodedPixels)==FALSE) %>%
  group_by(id) %>% 
  mutate(total = sum(n()/4)) %>% 
  ungroup() %>% 
  group_by(tg) %>% 
  summarise(n = sum(tem_erro),
            p = n/sum(total)) %>% 
  arrange(-p) # 41% dos defeitos é do tipo 3 XD

## # A tibble: 4 x 3
##   tg        n      p
##   <chr> <int>  <dbl>
## 1 3      5150 0.410 
## 2 1       897 0.0714
## 3 4       801 0.0637
## 4 2       247 0.0197

Para criar o banco de dados, precisamos transformar os dados de cada imagem em uma matriz, sendo que, na base de dados, cada foto será uma linha, e o número de colunas para cada imagem será de 256x1600.

# ----- Carregando imagens

# Separando diretorio das imagens
directory <- "/opt/datasets/steel/train_images_dir/"
id_images <- stringr::str_remove(path_images,pattern = "/opt/datasets/steel/train_images_dir/")
id_images

set.seed(111)
images_sample <- sample(1:length(id_images),size = 500,replace = FALSE)

img_train <- image_load(paste0(directory,id_images))
img_array <- keras::image_to_array(img_train)

images_train <- array(NA,dim = c(500,256,1600,1))

for(i in 1:500){
  cat("\n Processing",i,"of",500)
  img_train <- image_load(paste0(directory,id_images[i]))
  img_array <- keras::image_to_array(img_train)
  images_train[i,,,] <- img_array[,,1]
}

images_train_model <- images_train[1:350,,,]
images_test_model <- images_train[351:500,,,]

Note que ao selecionarmos o vetor com os labels, os mesmos não serão os correspondetes as imagens de forma correta. Será feito então uma manipulação para corrigir este problema.

id_images_id <- data.frame(id_images) %>% 
  mutate(i = 1:length(id_images))

id_images_id <- id_images_id[id_images_id$i[images_sample],]

targets <- train %>% 
  group_by(id) %>% 
  summarise(y = if_else(sum(is.na(EncodedPixels)==TRUE)==4,0,1)) %>% 
  ungroup() %>% 
  filter(id %in% id_images_id$id_images)

# Nao estao na mesma ordem
targets$id == id_images_id$id_images

y_train_model <- tibble(id = id_images[images_sample[1:1400]]) %>% 
  mutate(order = row_number()) %>% 
  left_join(targets,by = "id") %>% 
  arrange(order) %>% 
  select(y) %>% 
  unlist(use.names = FALSE) %>% 
  as.matrix()

y_test_model <- tibble(id = id_images[images_sample[1401:2000]]) %>% 
  mutate(order = row_number()) %>% 
  left_join(targets,by = "id") %>% 
  arrange(order) %>% 
  select(y) %>% 
  unlist(use.names = FALSE) %>% 
  as.matrix()

Agora, vamos treinar o modelo.

# Modelo básicao com amostra pequena

x_train_cnn <- array_reshape(images_train_model, c(350, 256, 1600, 1))/255 # Normalizando

x_test_cnn <- array_reshape(images_test_model, c(150, 256, 1600, 1))/255 # Normalizando

# input_shape <- c(256,1600)

set.seed(321)

model_cnn <- keras_model_sequential() %>%
  layer_conv_2d(
    filters = 32,
    kernel_size = c(3, 3),
    activation = 'relu',
    input_shape = c(256,1600,1)) %>%
  layer_conv_2d(filters = 64,
                kernel_size = c(3, 3),
                activation = 'relu') %>%
  layer_max_pooling_2d(pool_size = c(2, 2)) %>%
  layer_dropout(rate = 0.25) %>%
  layer_flatten() %>%
  # these are the embeddings (activations) we are going to visualize
  layer_dense(units = 16, activation = 'relu', name = 'features3') %>%
  layer_dropout(rate = 0.1) %>%
  layer_dense(units = 2, activation = 'softmax')

# Compile model
model_cnn %>% compile(
  loss = "categorical_crossentropy",
  optimizer = optimizer_adadelta(),
  metrics = c('accuracy')
)

summary(model_cnn)

history <- model_cnn %>% fit(
  x_train_cnn, to_categorical(y_train_model), 
  epochs = 3, batch_size = 10, 
  validation_split = 0.2
)

testando o modelo.

evaluate(model_cnn,x_test_cnn,to_categorical(y_test_model))

## $loss
## [1] 0.6932695
## 
## $accuracy
## [1] 0.4933333