Initial commit

.Rbuildignore

@@ -0,0 +1,3 @@
+^captcha\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.Rdata
+.httr-oauth
+.DS_Store

DESCRIPTION

@@ -0,0 +1,27 @@
+Package: captcha
+Title: Solve Captchas Using Torch
+Version: 0.0.0.9000
+Authors@R: 
+    c(person('Julio', 'Trecenti', 
+             email = '[email protected]', 
+             role = c('cre', 'aut'),
+             comment = c(ORCID = "0000-0002-1680-6389")))
+Description: This tool helps you download, visualize and solve captchas.
+  It is built as an extensible API so anyone can contribute with their
+  own captcha-solving code.
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1
+Imports: 
+    torch (>= 0.2.1),
+    magrittr (>= 2.0.1),
+    purrr (>= 0.3.4),
+    stringr (>= 1.4.0),
+    graphics,
+    grDevices,
+    tools,
+    magick,
+    fs,
+    usethis

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2021
+COPYRIGHT HOLDER: decryptr

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2021 decryptr
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,9 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(plot,captcha)
+S3method(print,captcha)
+export("%>%")
+export(classify)
+export(new_captcha)
+export(read_captcha)
+importFrom(magrittr,"%>%")

R/classify.R

@@ -0,0 +1,90 @@
+#' @title Classify captchas with their answers
+#'
+#' @description Given one or more captcha files, this function
+#' prompts you to break them mannually so that later you can train
+#' a model with those answers. Answered captchas are saved at `path`
+#' with their answers in the filename separated by an underscore.
+#'
+#' @param files A vector with the paths to captcha files
+#' @param answers Either `NULL` (for interactive classification) or
+#' a vector with answers for the captchas
+#' @param path Where to save the renamed (answered) captcha files
+#' (if `NULL`, will save each file on the same folder as its unanswered
+#' counterpart)
+#' @param rm_old Whether or not to delete unanswered captchas after
+#' copying and renaming them
+#' @param ... Other arguments passed on to [read_captcha()]
+#'
+#' @return A vector with the paths to the newly created files
+#'
+#' @export
+classify <- function(files, answers = NULL, path = NULL, rm_old = FALSE, ...) {
+
+  # Create directory if necessary
+  if (!is.null(path)) { dir.create(path, FALSE, TRUE) }
+
+  if (!is.null(answers)) {
+
+    # Stop if answers don't match captchas
+    stopifnot(length(answers) == length(files))
+
+    # Iterate over each captcha
+    files <- purrr::map2_chr(
+      files, answers, classify_,
+      path = path, rm_old = rm_old, ...)
+
+  } else {
+
+    # Prompt for each captcha
+    files <- purrr::map_chr(
+      files, classify_, ans = NULL,
+      path = path, rm_old = rm_old, ...)
+  }
+
+  return(files)
+}
+
+#' Classify a captcha with its answer
+#'
+#' @param cap The path to a captcha
+#' @param ans Either `NULL` (for interactive classification) or
+#' a string with the answer for the captcha
+#' @param path Where to save the renamed (answered) captcha file
+#' (if `NULL`, will save file on the same folder as its unanswered
+#' counterpart)
+#' @param rm_old Whether or not to delete unanswered captcha after
+#' copying and renaming them
+#' @param ... Other arguments passed on to [read_captcha()]
+#'
+classify_ <- function(cap, ans, path, rm_old, ...) {
+
+  # Read captcha
+  cap_ <- read_captcha(cap)[[1]]
+
+  # If interactive, prompt for answer
+  if (is.null(ans)) {
+
+    # TODO If passed a model, use it
+    if (!is.null(list(...)$model)) {
+      ans <- decrypt(cap, list(...)$model)
+    } else {
+      plot.captcha(cap_)
+      ans <- readline("Answer: ")
+    }
+  }
+
+  # Get information about where the file should be saved
+  file <- attr(cap_, "file")
+  name <- tools::file_path_sans_ext(basename(file))
+  ext <- tools::file_ext(basename(file))
+  path <- ifelse(is.null(path), dirname(file), normalizePath(path))
+
+  # Build name of new file
+  new_file <- stringr::str_c(path, "/", name, "_", ans, ".", ext)
+
+  # Copy file to new address
+  file.copy(file, new_file, overwrite = TRUE)
+  if (rm_old) { file.remove(file) }
+
+  return(new_file)
+}

R/decrypt.R

@@ -0,0 +1,8 @@
+decrypt <- function(file, mm) {
+  # ans <- calcular_x(file)$unsqueeze(1)$to(device = "cuda") %>%
+  #   # torch::valid_transforms() %>%
+  #   mm() %>%
+  #   torch::torch_max(dim = 3) %>%
+  #   purrr::pluck(2)
+  # paste(as.numeric(ans$to(device = "cpu")), collapse = "")
+}

R/new.R

@@ -0,0 +1,13 @@
+#' Create a new project to solve a custom captcha
+#'
+#' @param path A path. If it exists, it is used. If it does not exist,
+#'   it is created, provided that the parent path exists.
+#'
+#' @export
+new_captcha <- function(path) {
+  template <- system.file("template", package = "captcha")
+  fs::dir_copy(template, path)
+  usethis::proj_set(path, TRUE)
+  usethis::use_rstudio()
+  usethis::proj_activate(path)
+}

R/print.R

@@ -0,0 +1,71 @@
+#' Print information about a captcha
+#'
+#' @param x Captcha object read with [read_captcha()]
+#' @param ... -
+#'
+#' @export
+print.captcha <- function(x, ...) {
+  old_setup <- getOption("magick.viewer")
+  options(magick.viewer = NULL)
+  on.exit(options(magick.viewer = old_setup))
+  print(x$img)
+}
+
+#' Plot a captcha
+#'
+#' @param x Captcha object read with [read_captcha()]
+#' @param y Not used
+#' @param ... Other arguments passed on to [graphics::plot()]
+#'
+#' @export
+plot.captcha <- function(x, y, ...) {
+
+  # N <- getOption("captcha.print.max")
+  # if (length(x$img) > N) {
+  #   usethis::ui_todo(stringr::str_glue(
+  #     "Too many images, printing first {N}. ",
+  #     "To override, run options('captcha.print.max' = N_MAX)"
+  #   ))
+  # }
+
+  img <- x$img
+  lab <- x$lab
+
+  columns <- getOption("captcha.print.cols")
+  rows <- ceiling(length(img) / columns)
+  max_rows <- getOption("captcha.print.rows")
+
+  if (rows > max_rows) {
+    rows <- max_rows
+    img <- utils::head(img, rows * columns)
+    lab <- utils::head(lab, rows * columns)
+    usethis::ui_info(stringr::str_glue(
+      "Too many images, printing first {max_rows * columns}. ",
+      "To override, run"
+    ))
+    usethis::ui_todo("options('captcha.print.rows' = MAX_ROWS)")
+    usethis::ui_todo("options('captcha.print.cols' = COLUMNS)")
+  }
+
+  if (!is.null(lab)) {
+    img <- magick::image_annotate(
+      img, lab,
+      gravity = "northeast",
+      boxcolor = "white"
+    )
+  }
+
+  # res %>%
+  #   magick::image_border(color = "white", geometry = "5x5") %>%
+  #   magick::image_append(stack = TRUE)
+
+  img %>%
+    magick::image_border(color = "white", geometry = "5x5") %>%
+    magick::image_montage(
+      tile = stringr::str_glue("{columns}x{rows}"),
+      geometry = stringr::str_glue(
+        "{getOption('captcha.print.height')}x0+0+0"
+      )
+    )
+
+}

R/read.R

@@ -0,0 +1,56 @@
+#' @title Read captcha files
+#'
+#' @description Given the paths to one or more files, reads and converts
+#' them into a `captcha` list that can be used for classification or
+#' decryption. If `ans_in_path = TRUE`, will take the answer for the
+#' captchas from their filenames and get them ready for modeling.
+#'
+#' @param files Paths to one or more captcha images
+#' @param ans_in_path Whether or not the answers to the captchas are already
+#' in the paths to the files (separated by and underscore in the filename)
+#'
+#' @return A list of captcha objects
+#'
+#' @export
+read_captcha <- function(files, ans_in_path = FALSE) {
+
+  imgs <- magick::image_read(files)
+  labs <- NULL
+  if (ans_in_path) {
+    labs <- get_labels(files)
+  }
+
+  # Iterate over files
+  out <- list(img = imgs, lab = labs)
+  class(out) <- c("captcha")
+  return(out)
+}
+
+get_labels <- function(files) {
+  files %>%
+    basename() %>%
+    stringr::str_extract("(?<=_)[0-9a-zA-Z]+")
+}
+
+# calcular_y <- function(x) {
+#   x %>%
+#     basename() %>%
+#     stringr::str_extract("(?<=_)[0-9a-zA-Z]+") %>%
+#     purrr::map(stringr::str_split, "") %>%
+#     purrr::map(~torch::torch_tensor(as.integer(.x[[1]]))) %>%
+#     # TODO generalizar esse 9 para algo calculado
+#     purrr::map(torch::nnf_one_hot, 9) %>%
+#     torch:::torch_stack()
+# }
+#
+#
+# calcular_x <- function(x, dims = c(32L, 192L)) {
+#   x %>%
+#     purrr::map(torchvision::base_loader) %>%
+#     purrr::map(torchvision::transform_to_tensor) %>%
+#     purrr::map(torchvision::transform_rgb_to_grayscale) %>%
+#     torch:::torch_stack() %>%
+#     torchvision::transform_resize(dims)
+# }
+#
+

R/utils-pipe.R

@@ -0,0 +1,14 @@
+#' Pipe operator
+#'
+#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details.
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+#' @param lhs A value or the magrittr placeholder.
+#' @param rhs A function call using the magrittr semantics.
+#' @return The result of calling `rhs(lhs)`.
+NULL

R/zzz.R

@@ -0,0 +1,5 @@
+.onLoad <- function(libname, pkgname) {
+  options(captcha.print.rows = 25)
+  options(captcha.print.cols = 4)
+  options(captcha.print.height = 150)
+}

captcha.Rproj

@@ -0,0 +1,22 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+LineEndingConversion: Posix
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

inst/template/01_download.R

@@ -0,0 +1,23 @@
+# Write the script to download captcha files
+
+download_captcha <- function(n = 1, path = "img", ext = NULL) {
+
+  if (is.null(ext)) ext <- ".png"
+  purrr::map_chr(seq_len(n), ~download_captcha_one(path, ext))
+
+}
+
+download_captcha_one <- function(path, ext) {
+
+  # captcha url goes here
+  u_captcha <- ""
+  f_captcha <- fs::file_temp("captcha", path, ext)
+
+  # change method if necessary
+  httr::GET(
+    u_captcha,
+    httr::write_disk(f_captcha, TRUE)
+  )
+
+  f_captcha
+}

inst/template/02_classify.R

@@ -0,0 +1,7 @@
+f_captcha <- fs::dir_ls("img")
+
+# Option 1: classify manually
+captcha::classify(f_captcha, "img_train")
+
+# Option 2: shiny app
+captcha::classify_app(f_captcha, "img_train")