R/modelagem.R

In jtrecenti/captchasaj:

#' @export
treinar <- function(path, prop = .75) {
  full <- construir_bd(path)
  in_train <- caret::createDataPartition(full$letra, p = prop)[[1]]
  full <- data.frame(full)
  training <- full[in_train, ]
  testing <- full[-in_train, ]
  training$letra <- factor(training$letra)
  m <- caret::train(letra~., data = training[, -1], method = 'rf')
  testing$pred <- predict(m, testing, type = 'raw')
  oos <- sum(testing$pred != testing$letra) / nrow(testing)
  l <- list(modelo = m, oos = oos)
  return(l)
}

#' @export
classificar_online <- function(modelo, n = 100, path) {
  for(i in 1:n) {
    ainda_nao <- TRUE
    while(ainda_nao) {
      try({
        Sys.sleep(1)
        link <- 'http://esaj.tjsc.jus.br/cpopg/open.do'
        link_cap <- 'http://esaj.tjsc.jus.br/cpopg/imagemCaptcha.do'
        r <- httr::GET(link, httr::set_cookies(NULL))
        cap <- httr::GET(link_cap)
        tmp <- tempfile()
        writeBin(httr::content(cap, 'raw'), tmp)
        txt <- decodificar(tmp, modelo)
        link_pesq <- paste(c('http://esaj.tjsc.jus.br/cpopg/search.do?',
                             'conversationId=&dadosConsulta.localPesquisa.',
                             'cdLocal=-1&cbPesquisa=NUMPROC&dadosConsulta.',
                             'tipoNuProcesso=UNIFICADO&numeroDigitoAno',
                             'Unificado=',
                             '0001956-29.2010&foroNumeroUnificado=0011&dados',
                             'Consulta.valorConsultaNuUnificado=0001956-29.',
                             '2010.8.24.0011&dadosConsulta.valorConsulta=',
                             '&vlCaptcha=', txt), collapse = '')
        
        res <- httr::GET(link_pesq)
        passou <- stringr::str_detect(httr::content(res, 'text'), 
                                      'Dados do processo')
        if(passou) {
          d <- tmp %>% ler() %>% limpar() %>% picotar()
          classificar(d, txt, path)
          ainda_nao <- FALSE
        }
        httr::handle_reset(link)
      })
    }
  }
}

#' @export
decodificar <- function(arq, modelo) {
  d_test <- construir_bd_teste(arq)
  d_test <- d_test[, names(d_test) %in% modelo$coefnames]
  d_test[, modelo$coefnames[!modelo$coefnames %in% names(d_test)]] <- 0
  letras <- stats::predict(modelo, d_test)
  txt <- paste(letras, collapse = '')
  txt
}

construir_bd <- function(path) {
  arqs <- dir(paste0(path, '/'), full.names = TRUE)
  treino <- dplyr::bind_rows(
    lapply(arqs, function(x) {
      d <- readRDS(x)
      if(nrow(d) > 0) {
        d$arq <- x
        return(d)
      }
    })
  )
  if(is_windows()) { # se o sistema operacional for windows...
    letra_regex <- '.+\\/([a-zA-Z])'
  } else {
    letra_regex <- '.+//([a-zA-Z])'
  }
  treino$letra <- stringr::str_match(treino$arq, letra_regex)[, 2]
  d_treino <- treino %>%
    dplyr::mutate(xs = sprintf('x%02d', x), ys = sprintf('y%02d', y)) %>%
    tidyr::unite(xy, xs, ys, sep = '_') %>%
    dplyr::select(arq, xy, letra) %>%
    tidyr::spread(xy, letra, fill = 0) %>%
    dplyr::mutate_at(dplyr::vars(dplyr::starts_with('x')), dplyr::funs(ifelse(.=='0', 0, 1))) %>%
    dplyr::mutate(letra = stringr::str_match(arq, letra_regex)[, 2])
  d_treino
}

construir_bd_teste <- function(arq) {
  d <- arq %>%
    ler() %>%
    limpar() %>%
    picotar()
  d$letra <- as.character(d$grupo)
  d_teste <- d %>%
    dplyr::ungroup() %>%
    dplyr::select(x, y, letra, grupo) %>%
    dplyr::mutate(xs = sprintf('x%02d', x), ys = sprintf('y%02d', y)) %>%
    tidyr::unite(xy, xs, ys, sep = '_') %>%
    dplyr::select(xy, letra, grupo) %>%
    tidyr::spread(xy, letra, fill = 0) %>%
    dplyr::select(-grupo) %>%
    dplyr::mutate_at(dplyr::vars(dplyr::starts_with('x')), dplyr::funs(ifelse(.=='0', 0, 1)))
  d_teste
}