R/processamento.R

In jtrecenti/captchaReceita: Quebrando Captcha Da Receita

#------------------------------------------------------------------------------

#' Função para converter a imagem em uma matriz 180x50
#'
#' @export
converter_em_matriz <- function(d) {
  d %>% 
    dplyr::select(x, y, r) %>% 
    tidyr::spread(x, r, fill = 1) %>% 
    dplyr::select(-y) %>% 
    as.matrix()
}


#' Função para converter a imagem em um data.frame do jeito correto
#'
#'
#' @export
converter_em_df <- function(m) {
  as.data.frame(m) %>% 
    dplyr::mutate(y = as.numeric(1:nrow(.))) %>%
    tidyr::gather(x, r, -y) %>%
    dplyr::mutate(x = tidyr::extract_numeric(x)) 
}

#' Tira pontos que nao tenham pixels maior ou igual a k na vizinhança de n
#' 
#' @export
tirar_sujeira <- function(d, k = 6, n = 1, r_lim = 0, 
                          tab_completa = expand.grid(x = 0:170, y = 0:30)) {
  fk <- function(x, ...) {9 - sum(x)}
  mk <- matrix(1, 1 + 2 * n, 1 + 2 * n)
  arrumado <- dplyr::left_join(tab_completa, d, c('x', 'y')) %>% 
    dplyr::mutate(r = ifelse(is.na(r), 1, r), r = ifelse(r > r_lim, 1, 0))
  for(j in k) {
    m_inicial <- arrumado %>% converter_em_matriz()
    m <- m_inicial %>%
      raster::raster() %>%
      raster::focal(mk, fk, pad = TRUE, padValue = 1) %>%
      raster::as.matrix()
    m <- ifelse(m >= j & m_inicial == 0, 0, 1)
    arrumado <- converter_em_df(m)
  }
  arrumado %>% dplyr::filter(r == 0)
}



#------------------------------------------------------------------------------

#' Alinhar
#'
#' @export
alinhar <- function(d, total = TRUE) {
  if(!total) {
    res <- d %>%
      dplyr::ungroup() %>%
      dplyr::mutate(minimo_x = min(x)) %>%
      dplyr::group_by(grupo) %>%
      dplyr::mutate(x = x - minimo_x, y = y - min(y)) %>%
      dplyr::ungroup() %>%
      dplyr::select(-minimo_x)
  } else {
    res <- d %>%
      dplyr::group_by(grupo) %>%
      dplyr::mutate(y = y - min(y), x = x - min(x)) %>%
      dplyr::ungroup()
  }
  res
}

#------------------------------------------------------------------------------

#' Arrumar bd e colocar no modo para regressao
#'
#' @export
arrumar_bd <- function(arq, spr = TRUE) {
  arq <- arq[1]
  d <- readRDS(arq)
  arrumado <- d %>%
    dplyr::filter(y >= 12, y <= 42, x >= 10, x <= 180) %>%
    dplyr::mutate(y = y - 12, x = x - 10) %>%
    tirar_sujeira(k = c(5, 5, 5)) %>%
    picotar() %>%
    dplyr::group_by(grupo) %>%
    dplyr::do(tirar_sujeira(., c(4, 4, 4))) %>%
    dplyr::ungroup() %>%
    picotar() %>%
    alinhar() %>%
    dplyr::group_by(grupo) %>%
    dplyr::filter(x <= 25, y <= 25) %>%
    dplyr::do(resize_image(., 20, 20)) %>%
    dplyr::ungroup()
  if(spr) {
    arrumado <- arrumado %>%
      dplyr::mutate(xy = sprintf('x%02d_y%02d', x, y), um = 1) %>%
      dplyr::select(grupo, xy, um) %>%
      tidyr::spread(xy, um, fill = 0) %>%
      #arrange(grupo) %>%
      dplyr::select(-grupo) %>%
      dplyr::mutate(letra = pega_letra(arq))
  }
  arrumado
}

#------------------------------------------------------------------------------

pega_letra <- function(arq) {
  if(stringr::str_detect(arq, '^/tmp')) return('')
  re <- '([A-Z0-9]{6})_[0-9]+\\.rds'
  x <- unlist(strsplit(str_match(arq[1], re)[, 2], ''))
  x
}

#------------------------------------------------------------------------------

#' Monta bd de treino a partir de vetor de arquivos
#'
#' @export
montar_bd_treino <- function(arqs) {
  bd <- data_frame(arq = arqs) %>%
    dplyr::group_by(arq) %>%
    dplyr::do(arrumar_bd(.$arq)) %>%
    dplyr::mutate_each(funs(ifelse(is.na(.), 0, .)), starts_with('x')) %>%
    dplyr::ungroup() %>%
    dplyr::select(-arq)
  bd
}

#------------------------------------------------------------------------------

#' Novo picotar
#' 
#' se o connected components retornar 6, os grupos são esses connected components
#' se não, preciso verificar quais componentes não agruparam direito
#' para cada um desses componentes, eu preciso aplicar uma quantidade de cortes
#' posso usar intervalos igualmente espaçados dos pixels ou kmeans
#' 
#' @export
picotar <- function(d) {
  tab_completa <- expand.grid(x = 0:170, y = 0:30)
  um_menos <- function(x) 1 - x
  d_out <- dplyr::left_join(tab_completa, d, c('x', 'y')) %>% 
    dplyr::mutate(r = ifelse(is.na(r), 1, 0)) %>%
    converter_em_matriz() %>%
    um_menos() %>%
    SDMTools::ConnCompLabel() %>%
    converter_em_df() %>%
    dplyr::group_by(r) %>%
    dplyr::mutate(n = n(), 
           n_comp = diff(range(x)),
           n_comp = ifelse(n_comp <= 35 * 1 - 8 * 0, 1,
                    ifelse(n_comp <= 35 * 2 - 8 * 1, 2,
                    ifelse(n_comp <= 35 * 3 - 8 * 2, 3,
                    ifelse(n_comp <= 35 * 4 - 8 * 3, 4,
                    ifelse(n_comp <= 35 * 5 - 0 * 4 - 10, 5, 6)))))) %>%
    dplyr::ungroup() %>%
    dplyr::filter(n > 60, r != 0) %>%
    dplyr::mutate(r = as.numeric(factor(r, levels = unique(r))))
  
  comps <- d_out %>% dplyr::distinct(r) %>% with(n_comp)
  if(sum(comps) != 6) {
    km <- kmeans(d_out[, c('x')], (c(25, 55, 85, 115, 140, 165) - 10))
    d_out$grupo <- km$cluster
  } else {
    if(all(comps == 1)) {
      d_out$grupo <- d_out$r
    } else {
      rs <- unique(d_out$r)
      d_out$grupo <- ''
      for(i in 1:length(rs)) {
        ri <- rs[i]
        if(comps[i] == 1) {
          d_out[d_out$r == ri,]$grupo <- paste(ri, 1, sep = '_')
        } else {
          ran <- range(d_out[d_out$r == ri,]$x)
          cuts <- seq(ran[1], ran[2], diff(ran) / comps[i])
          km <- kmeans(d_out[d_out$r == ri, c('x')], 
                       (cuts[-1] + cuts[-length(cuts)]) / 2)
          d_out[d_out$r == ri,]$grupo <- paste(ri, km$cluster, sep = '_')
        }
      }
    }
  }
  d_out$r <- 0
  return(d_out)
}

#------------------------------------------------------------------------------

#' Resize image
#'
#' http://stackoverflow.com/questions/10865489/scaling-an-r-image
#'
#' @export
resize_image = function(dr, w.out, h.out) {
  im <- converter_em_matriz(dr)
  w.in = nrow(im)
  h.in = ncol(im)
  # Create empty matrix
  im.out = matrix(rep(0, w.out * h.out), nrow = w.out, ncol = h.out )
  # Compute ratios -- final number of indices is n.out, spaced over range of 1:n.in
  w_ratio = w.in / w.out
  h_ratio = h.in / h.out
  # Do resizing -- select appropriate indices
  im.out <- im[ floor(w_ratio * 1:w.out), floor(h_ratio * 1:h.out)]
  rownames(im.out) <- 1:nrow(im.out)
  colnames(im.out) <- 1:ncol(im.out)
  d_out <- converter_em_df(im.out) %>% dplyr::filter(r < 1)
  d_out$grupo <- dr$grupo[1]
  return(d_out)
}

#------------------------------------------------------------------------------