This is very similar to Joseph Abrahamson's solution. The main
difference is that I use separate databases for each part of the
question: the initial set-up, the operation (addition or subtraction),
and the final question. I also got a little silly with the text of the
questions.
This code can be extended to other operations by adding to the
*operations* list and creating another *Xstrings* list, where X is the
symbol name of the operation (e.g. +, -, *, ...).
My goal was to add enough "noise" to the question that it could not be
solved by simple text calculators such as Google. It's still pretty
easy to crack this once you know the algorithm -- just scan the question
string for numbers, add or subtract them, and you've got a 50% chance of
getting the right answer.
Code attached.
-Stuart
;; CAPTCHA.TEXT.ARITHMETIC
;; version 1, released 3 May 2006
;; A text-based CAPTCHA (completely automated public Turing test to
;; tell computers and humans apart) in ANSI Common Lisp.
;; This Lisp package has one public function, GENERATE-CAPTCHA, called
;; with no arguments. It returns two strings, the first containing a
;; question and the second containing the answer. The answer will
;; always be in the form of numerical digits.
;; Example:
;; > (generate-captcha)
;; "You started out with three Lisp Machines. You bought ten. In the
;; end, how many did you have?"
;; "13"
;; Copyright 2006 Stuart Sierra
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
;; CAPTCHA is a trademark of Carnegie Mellon University
(in-package :common-lisp-user)
;; package names should be descriptive ;)
(defpackage :com.stuartsierra.captcha.text.arithmetic
(:nicknames :captcha)
(:use :common-lisp)
(:export #:generate-captcha))
(in-package :com.stuartsierra.captcha.text.arithmetic)
(defvar *min-initial-value* 12)
(defvar *max-initial-value* 50)
(defvar *min-delta-value* 2)
(defvar *max-delta-value* 10)
(defvar *operations*
(list '+ '-))
(defvar *initial-state-strings*
(list "You started out with ~a."
"Before, you had ~a."
"In the beginning, there were ~a."
"Once upon a time, you had ~a."
"You were in possession of ~a."
"In the vague, distant past, ~a were your pride and joy."))
(defvar *+strings*
(list "Beneficent aliens from planet Grog gave you ~a."
"Your third cousin Warrl died and you inherited his ~a."
"By devious and suble means, you acquired an additional ~a."
"You quit your job and got ~a as part of your severance package."
"You lost them all in a stock deal, but then you got them all back plus ~a."
"You bought ~a."))
(defvar *-strings*
(list "When you least expected it, your best friend turned on you and stole ~a."
"Just as you were starting to enjoy them, ~a ran away."
"But, tragically, ~a went off to that big something-or-other in the sky."
"However, ~a didn't feel like sticking around, and left."
"After a few years, ~a and you didn't get along any more, so they left."
"Not through any fault of your own, you lost ~a."))
(defvar *question-strings*
(list "When all is said and done, what did you end up with?"
"How many did you have after that?"
"By the end of the story, you had how many?"
"Years later, when you were reflecting on this whole sordid process, you counted up how many you had. What was the result?"
"What number did you have then, after you got over the emotional shock?"
"Tell me how many you had when you finished."))
(defvar *nouns*
(list "apples" "ponies" "pieces of fruit" "PDP-10s" "laptops"
"clones of William Shatner" "Lisp Machines" "ice cream cones"
"lollipops" "oranges" "brown paper packages tied up with string"
"first-edition Superman comic books" "pairs of stiletto heels"))
(defun pick-random (list)
(nth (random (length list)) list))
(defun random-range (min max)
(+ min (random (- max min))))
(defun format-quantity (number noun)
(format nil "~r ~a" number noun))
(defun generate-initial-state-string (initial-value noun)
(format nil (pick-random *initial-state-strings*)
(format-quantity initial-value noun)))
(defun generate-change-string (operation delta-value noun)
(format nil (pick-random
(symbol-value
(find-symbol
(concatenate 'string "*"
(symbol-name operation)
(symbol-name :strings*)) ; to allow for lowercase readers
:com.stuartsierra.captcha.text.arithmetic)))
(format-quantity delta-value noun)))
(defun generate-question (operation initial-value delta-value)
(let ((noun (pick-random *nouns*)))
(format nil "~a ~a ~a"
(generate-initial-state-string initial-value noun)
(generate-change-string operation delta-value noun)
(pick-random *question-strings*))))
(defun generate-answer (operation initial-value delta-value)
(format nil "~d" (funcall operation initial-value delta-value)))
(defun generate-captcha ()
(let ((initial-value (random-range *min-initial-value* *max-initial-value*))
(operation (pick-random *operations*))
(delta-value (random-range *min-delta-value* *max-delta-value*)))
(values (generate-question operation initial-value delta-value)
(generate-answer operation initial-value delta-value))))
