"Completely Automated Public Turing test to tell Computers and Humans Apart"
Teste de Turing público completamente automatizado para diferenciação entre computadores e humanos
O que é um Captcha
Objetivo
Porque quebrar um captcha?
- impedem o acesso a uma informação pública (ex: tribunais, receita federal, etc.)
Porque não quebrar?
- muitas vezes os captchas protegem formulários na internet (ex: imagina se fosse possÃvel criar milhares de contas de email automaticamente p/ gerar spam?)
Representação de uma imagem
No computador uma imagem pode ser representada por uma trinca de matrizes.
- cada matriz representa uma das cores (r: red, g: green, b: blue) e,
- cada elemento da matriz representa um pixel da imagem
No R, você pode ler uma imagem assim:
library(magrittr)
library(captchaReceita)
png::readPNG("../captcha.jpeg") %>% str
## num [1:50, 1:180, 1:4] 0.0824 0.0275 0.9373 1 1 ...
Representação no captchaReceita
No pacote captchaReceita o captcha será representado por um data.frame
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
}
Representação no captchaReceita
captcha <- captchaReceita::ler("../captcha.jpeg")
head(captcha)
## x y r g b cor id ## 1 1 50 0.08235294 0.08235294 0.08235294 #151515 1 ## 2 1 49 0.02745098 0.02745098 0.02745098 #070707 2 ## 3 1 48 0.93725490 0.93725490 0.93725490 #EFEFEF 3 ## 4 1 33 0.45098039 0.45098039 0.45098039 #737373 18 ## 5 1 32 0.88235294 0.88235294 0.88235294 #E1E1E1 19 ## 6 1 30 0.68235294 0.68235294 0.68235294 #AEAEAE 21
desenhar
desenhar <- function(d){
d <- dplyr::mutate(d, cor = rgb(r, r, r), id = 1:n())
p <- ggplot2::ggplot(d, ggplot2::aes(x = x, y = y))
p <- p +
ggplot2::coord_equal() +
ggplot2::theme_bw()
p <- p + ggplot2::geom_point(colour = d$cor, shape = 15, size = 3)
p +
ggplot2::scale_x_continuous(breaks = 0:1000 * 3) +
ggplot2::scale_y_continuous(breaks = 0:100 * 5)
}
desenhar
captcha %>% desenhar()
Tratamento da imagem
Como a imagem é feita para não ser reconhecida por computadores, ela vem com algumas distorções. Neste caso riscos e pontos foram adicionados à imagem.
Por isso é necessário fazer um tratamento:
processar(captcha) %>% desenhar()
Tratamento 1: cortar()
Observei que a maioria dos captchas não aparecia abaixo de x = 10 e de y = 12.
cortar <- function(img, x_min = 10, x_max = 180, y_min = 12, y_max = 42){
img %>%
dplyr::filter(y >= y_min, y <= y_max, x >= x_min, x <= x_max) %>%
dplyr::mutate(y = y - y_min, x = x - x_min)
}
Tratamento 2: limpar()
Retirar os pontos que não possuem pelo menos 6 pontos pretos ao lado.
limpar <- function(img, n = 1, k = 6, x = 170, y = 30, lim = 0){
fk <- function(x) {sum(x == 0)}
mk <- matrix(1, 1 + 2 * n, 1 + 2 * n)
arrumado <- preencher(img, x, y, lim)
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)
}
Resultado
captcha %>% cortar %>% limpar %>% desenhar
Tratamento 3: picotar()
Separar as letras: apenas observando as imagens.
picotar <- function(img, cortes = c(25, 55, 85, 120, 147)){
img %>%
dplyr::mutate(
posicao = 6,
posicao = ifelse(x <= cortes[5], 5, posicao),
posicao = ifelse(x <= cortes[4], 4, posicao),
posicao = ifelse(x <= cortes[3], 3, posicao),
posicao = ifelse(x <= cortes[2], 2, posicao),
posicao = ifelse(x <= cortes[1], 1, posicao)
) %>%
dplyr::group_by(posicao) %>%
dplyr::mutate(
x = x - min(x),
y = y - min(y)
) %>%
dplyr::ungroup()
}
Resultado
captcha %>% cortar %>% limpar %>% picotar %>% desenhar
Tratamentos 4 a 6: limpar, alinhar, redimensionar
- Repetimos a função
limparpara cada letra da imagem, assim pontos da borda podem sumir. - Caso algum ponto tenha sumido, o alinhamento corrige.
- Redimensionar: transforma todas as letras em imagens 20x20.
Resultado
captcha %>% cortar %>% limpar %>% picotar %>% limpar_por_posicao %>% alinhar_por_posicao %>% redimensionar_por_posicao %>% desenhar
Preparação do banco p/ modelagem
O processamento descrito foi repetido 3x para cada imagem. Para três combinações de pontos de picotar. Assim, se uma imagem está muito distorcida, em algum dos "picotes" ela estará cortada de forma razoável. Depois disso um banco de dados foi formado empilhando todas as imagens.
preparar <- function(dir, cortes = list(
"1" = c(25, 55, 85, 120, 147),
"2" = c(30, 55, 87, 117, 145),
"3" = c(27, 60, 87, 120, 148)
)){
r <- plyr::ldply(cortes, function(c, dir){
arrumar(dir, cortes = c)
}, dir = dir, .id = "corte")
r$posicao <- as.factor(r$posicao)
r$letras <- r$letras %>% tolower %>% as.factor
return(r)
}
Modelagem: Banco de Dados
Banco de dados:
load("../data/bd.rda")
str(bd)
## 'data.frame': 19800 obs. of 404 variables: ## $ corte : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ... ## $ arqs : chr "016PGD_97499431.rds" "016PGD_97499431.rds" "016PGD_97499431.rds" "016PGD_97499431.rds" ... ## $ posicao: Factor w/ 6 levels "1","2","3","4",..: 1 2 3 4 5 6 1 2 3 4 ... ## $ x01y02 : num 1 1 1 1 1 0 1 1 1 0 ... ## $ x01y03 : num 1 1 1 1 1 0 1 1 1 1 ... ## $ x01y04 : num 1 1 1 1 0 0 1 1 1 1 ... ## $ x01y05 : num 1 1 1 0 1 0 1 1 1 1 ... ## $ x01y06 : num 1 1 1 1 1 0 1 1 1 1 ... ## $ x01y07 : num 1 1 0 1 1 0 1 1 1 1 ... ## $ x01y08 : num 1 1 0 1 1 0 0 1 1 1 ... ## $ x01y09 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x01y10 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x01y11 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x01y12 : num 1 1 1 1 1 0 0 1 1 1 ... ## $ x01y13 : num 1 1 1 1 1 0 0 1 1 1 ... ## $ x01y14 : num 1 1 1 1 1 0 1 1 1 1 ... ## $ x01y15 : num 1 1 1 1 1 0 1 1 1 1 ... ## $ x01y16 : num 1 1 1 1 1 0 1 0 1 1 ... ## $ x01y17 : num 1 1 1 1 0 0 1 1 1 1 ... ## $ x01y18 : num 1 0 1 1 1 1 1 1 1 1 ... ## $ x01y19 : num 1 0 1 1 1 1 1 1 0 1 ... ## $ x02y01 : num 1 1 1 1 1 0 1 1 1 0 ... ## $ x02y02 : num 1 1 1 1 1 0 1 1 1 0 ... ## $ x02y03 : num 1 0 1 0 0 0 1 1 1 1 ... ## $ x02y04 : num 1 0 0 0 0 0 1 1 1 1 ... ## $ x02y05 : num 1 1 0 0 0 0 1 1 1 1 ... ## $ x02y06 : num 1 1 1 0 1 0 1 1 1 1 ... ## $ x02y07 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x02y08 : num 0 0 1 1 1 0 0 1 1 1 ... ## $ x02y09 : num 0 0 1 1 1 0 0 1 1 1 ... ## $ x02y10 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x02y11 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x02y12 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x02y13 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x02y14 : num 1 1 1 1 1 0 0 1 1 1 ... ## $ x02y15 : num 1 1 1 1 1 0 1 1 1 1 ... ## $ x02y16 : num 1 1 1 1 0 0 1 0 1 1 ... ## $ x02y17 : num 1 1 1 1 0 0 1 0 0 1 ... ## $ x02y18 : num 1 0 1 1 0 0 1 1 0 1 ... ## $ x02y19 : num 1 0 1 1 0 1 1 1 0 1 ... ## $ x02y20 : num 1 1 1 0 1 1 1 1 1 0 ... ## $ x03y01 : num 1 1 1 1 1 0 1 0 1 0 ... ## $ x03y02 : num 1 0 1 0 1 0 1 0 1 0 ... ## $ x03y03 : num 1 0 1 0 0 0 1 1 1 0 ... ## $ x03y04 : num 1 0 0 0 0 0 1 1 1 1 ... ## $ x03y05 : num 0 1 0 0 0 0 0 1 1 1 ... ## $ x03y06 : num 0 1 1 0 1 0 0 1 1 1 ... ## $ x03y07 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y08 : num 0 0 1 1 1 0 0 1 1 1 ... ## $ x03y09 : num 0 0 1 1 1 0 0 1 1 0 ... ## $ x03y10 : num 0 1 1 1 1 0 0 1 1 0 ... ## $ x03y11 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y12 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y13 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y14 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y15 : num 0 1 1 1 1 0 0 1 1 1 ... ## $ x03y16 : num 1 1 1 1 1 0 0 0 1 1 ... ## $ x03y17 : num 1 1 1 1 0 0 1 0 0 1 ... ## $ x03y18 : num 1 0 1 1 0 0 1 1 0 1 ... ## $ x03y19 : num 1 0 1 1 0 1 1 1 0 0 ... ## $ x03y20 : num 1 1 1 0 1 1 1 1 0 0 ... ## $ x04y01 : num 1 1 1 0 1 0 1 0 1 1 ... ## $ x04y02 : num 1 0 1 0 0 0 1 0 1 0 ... ## $ x04y03 : num 1 0 1 0 0 0 1 1 1 0 ... ## $ x04y04 : num 0 0 0 0 0 0 0 1 1 0 ... ## $ x04y05 : num 0 1 0 0 1 0 0 1 1 0 ... ## $ x04y06 : num 0 1 0 0 1 0 0 1 1 0 ... ## $ x04y07 : num 0 1 0 1 1 0 0 1 1 0 ... ## $ x04y08 : num 0 0 0 1 1 0 1 1 1 0 ... ## $ x04y09 : num 1 0 0 1 1 0 1 1 1 0 ... ## $ x04y10 : num 1 1 0 1 1 0 1 1 1 0 ... ## $ x04y11 : num 1 1 0 1 0 0 1 1 1 0 ... ## $ x04y12 : num 1 1 1 1 0 0 1 1 1 0 ... ## $ x04y13 : num 0 1 1 1 1 0 1 1 1 0 ... ## $ x04y14 : num 0 1 1 1 1 0 1 1 1 0 ... ## $ x04y15 : num 0 1 1 1 1 0 0 1 1 0 ... ## $ x04y16 : num 0 1 1 1 1 0 0 1 1 0 ... ## $ x04y17 : num 0 1 1 1 1 0 0 0 1 0 ... ## $ x04y18 : num 1 0 1 1 1 0 1 1 0 0 ... ## $ x04y19 : num 1 0 1 1 0 1 1 1 0 0 ... ## $ x05y01 : num 1 1 1 0 1 0 1 0 1 1 ... ## $ x05y02 : num 1 0 1 0 0 0 1 0 1 0 ... ## $ x05y03 : num 0 0 1 0 0 0 1 1 1 0 ... ## $ x05y04 : num 0 0 0 0 0 1 0 1 1 0 ... ## $ x05y05 : num 1 1 0 0 1 1 0 1 1 0 ... ## $ x05y06 : num 1 1 0 0 1 1 0 1 1 0 ... ## $ x05y07 : num 1 1 0 1 1 1 1 1 1 0 ... ## $ x05y08 : num 1 0 0 1 1 1 1 1 1 0 ... ## $ x05y09 : num 1 0 0 1 1 1 1 1 1 0 ... ## $ x05y10 : num 1 1 0 1 1 1 1 1 1 0 ... ## $ x05y11 : num 1 1 0 1 0 1 1 1 1 0 ... ## $ x05y12 : num 1 1 0 1 0 1 1 1 1 0 ... ## $ x05y13 : num 1 1 0 1 1 1 1 1 1 0 ... ## $ x05y15 : num 0 1 1 1 1 1 1 1 1 0 ... ## $ x05y16 : num 0 1 1 1 1 1 0 1 1 0 ... ## $ x05y17 : num 0 1 1 0 1 0 0 0 1 0 ... ## $ x05y18 : num 0 1 1 0 1 0 1 0 1 0 ... ## $ x05y19 : num 1 0 1 1 0 1 1 1 0 0 ... ## $ x06y01 : num 1 1 1 0 0 0 1 0 1 1 ... ## [list output truncated]
Modelagem
O banco foi separado base de treino e de teste.
load("../data/bd_s.rda")
library(randomForest)
modelo <- randomForest(letras ~ ., data = bd_s$treino %>% dplyr::select(-arqs))
Erro de predição
library(randomForest)
## randomForest 4.6-12
## Type rfNews() to see new features/changes/bug fixes.
calcular_erro(bd_s$teste)
## acerto valor ## 1 captcha 0.8100000 ## 2 letra 0.9633333
Predição do captcha inicial
captcha %>% desenhar()
decodificar("../captcha.jpeg", modelo)
## [1] "nyv8ew"