R/processamento.R

In jtrecenti/captchasaj:

#' Baixa um captcha do TJSP
#' 
#' @export
baixar <- function() {
  link <- 'https://esaj.tjsp.jus.br/cjsg/imagemCaptcha.do'
  tmp <- tempfile()
  f <- utils::download.file(link, tmp, method = 'wget', quiet = TRUE,
                            extra = '--no-check-certificate')
  if(f == 0) {
    return(tmp)
  }
  stop('erro no download')
}

#' @export
ler <- function(a) {
  img <- png::readPNG(a)
  img_dim <- dim(img)
  img_df <- data.frame(
    x = rep(1:img_dim[2], each = img_dim[1]),
    y = rep(img_dim[1]:1, img_dim[2]),
    r = as.vector(img[,,1]),
    g = as.vector(img[,,2]),
    b = as.vector(img[,,3])
  )
  d <- dplyr::mutate(img_df, cor = rgb(r, g, b), id = 1:n())
  d <- dplyr::filter(d, cor != '#FFFFFF')
  d
}

#' @export
picotar <- function(d) {
  somas <- dplyr::summarise(dplyr::group_by(d, x), soma = length(y))
  somas <- dplyr::arrange(somas, x)
  x <- somas$x
  grupos <- integer(length(x))
  grupos[1] <- 1
  k <- 1
  for(i in 2:length(x)) {
    if(!x[i - 1] %in% (x[i] - 1:3)) {
      k <- k + 1
    }
    grupos[i] <- k
  }
  somas$grupo <- grupos
  if(length(unique(grupos)) != 5) stop('N\u00E3o picotei direito...')
  d2 <- dplyr::inner_join(d, somas, 'x')
  d2 <- dplyr::group_by(d2, grupo)
  d2 <- dplyr::mutate(d2, x = x - min(x), y = y - min(y))
  d2
}

contiguos <- function(d, x, y) {
  continua <- TRUE
  while(continua) {
    ind <- max(x) + 1
    if(nrow(d[d$x == ind & d$y == y, ]) > 0) {
      x <- c(x, ind)
    } else {
      continua <- FALSE
    }
  }
  return(x)
}

encontra_prox <- function(d, x, y, tipo) {
  for(i in -3:3) {
    fun <- ifelse(i <= 0, min, max)
    x_pesq <- fun(x) + i
    if(nrow(d[d$x == x_pesq & d$y == y - 1 * tipo, ]) > 0) {
      return(x_pesq)
    }
  }
}

tira_reta <- function(d, x, y, tipo, times = 4) {
  x_prox <- contiguos(d, x, y)
  x <- x_prox
  for(i in 1:times) {
    x_prox <- encontra_prox(d, x_prox, y, tipo)
    y <- y - 1 * tipo
    x_prox <- contiguos(d, x_prox, y)
  }
  sl <- - times * tipo / (mean(x_prox) - mean(x))
  int <- y + times * tipo - sl * mean(x)
  dl <- d
  for(y in 18:40) {
    x <- (y - int) / sl
    janela_x <- dl$x >= x - 2.5 & dl$x <= x + 2.5
    janela_y <- dl$y == y
    quadrado <- unique(dl[janela_x & (dl$y == y + 1), ]$x)
    dl <- dl[!(janela_x & janela_y & !dl$x %in% quadrado), ]
  }
  ind <- apply(dl, 1, function(a) {
    vet <- (-1):1
    pontos <- sapply(vet, function(y) sapply(vet, function(z) c(x + y, x + z)))
    x <- as.numeric(a[1])
    y <- as.numeric(a[2])
    txt <- paste(x, y)
    m <- character(9)
    k <- 1
    for(z in vet) {
      for(w in vet) {
        m[k] <- paste(x + z, y + w)
        k <- k + 1
      }
    }
    m <- m[-5]
    txt_dl <- paste(dl$x, dl$y)
    any(m %in% txt_dl)
  })
  dl <- dl[ind, ]
  dl
}

tirar_retas <- function(d) {
  xizes <- unique(d[d$y == 40, ]$x)
  tipo <- 1
  y <- 40
  if(length(xizes) == 0) {
    tipo <- -1
    y <- 18
    xizes <- unique(d[d$y == 18, ]$x)
    if(length(xizes) == 0) return(d)
  }
  tirar <- rep(TRUE, length(xizes))
  for(i in seq_along(xizes[-1])) {
    if(xizes[i + 1] == xizes[i] + 1) {
      tirar[i + 1] <- FALSE
    }
  }
  xizes <- xizes[tirar]
  dl <- d
  for(xis in xizes) {
    dl <- tira_reta(dl, xis, y, tipo)
  }
  dl
}

#' @export
limpar <- function(d) {
  d <- dplyr::filter(d, y >= 18, y <= 40)
  d <- dplyr::group_by(d, cor)
  d <- dplyr::mutate(d, n = length(cor))
  d <- dplyr::ungroup(d)
  d <- dplyr::filter(d, n == max(n))
  d <- tirar_retas(d)
  d <- dplyr::filter(d, y > 18, y < 40)
  d
}