[quiz] [QUIZ #1] Solution by Joseph Abrahamson

[Tel]

Here's my take at it, though it's obviously the work of a beginner.

CL-USER> (captcha:generate-captcha)
"what is six plus four?"
"10"
CL-USER> (captcha:generate-captcha)
"what is the difference between five and four?"
"1"
CL-USER> (loop for x from 1 to 1000
	       do (captcha:generate-captcha))
NIL

~~~~~~~~~~



;;;;;;;;;;;;;;
;
;  CAPTCHA
;  -------
;  A Completely Automated Public Turing test
;    to tell Computers and Humans Apart
;    generator.
;  Generates simple written arithmatic problems.
;
;  -- DEPENDS on:
;     "Iterate":http://common-lisp.net/project/iterate/
;
;
;  AUTHOR: Joseph Abrahamson
;  YEAR:   2006
;
;;;;;;;;;;;;;;

(defpackage :captcha
  (:use :cl)
  (:export #:generate-captcha))

(in-package :captcha)


(defconstant +numbermax+ 10)

(defvar *query-strings* '((* "what is ~r times ~r?"
			   (gennumber gennumber))
			  (* "what is the product of ~r and ~r?"
			   (gennumber gennumber))
			  (* "what is the area of a ~r by ~r rectangle?"
			   (gennumber gennumber))
			  (* "If you have ~r card~:p in a deck, then give the deck away,
how many cards do you have?~*"
			   (gennumber 0))
			  (+ "what is ~r plus ~r?"
			   (gennumber gennumber))
			  (+ "what is the sum of ~r, ~r, and ~r?"
			   (gennumber gennumber gennumber))
			  (+ "if you have ~r apricot~:p and buy ~r more, how many do you have?"
			   (gennumber gennumber))
			  (- "what is ~r less ~r?"
			   (gennumber gennumber))
			  (- "what is the difference between ~r and ~r?"
			   (gennumber gennumber))
			  (- "if you have ~r dollar~:p but owe ~r, you effectively have how many?"
			   (gennumber gennumber))
			  (/ "what is ~r over ~r?"
			   (gennumber gennumber))
			  (/ "what is the quotient of ~r and ~r"
			   (gennumber gennumber))
			  (/ "if you split ~r watch~:*~[es~;~:;es~] into ~r equal group~:p,
how many are in each group?"
			   (gennumber gennumber))))
; Etc...

(defun gennumber (&optional (max +numbermax+) (min 0))
  (+ (random (- max min)) min))

(defclass query ()
  ((text
    :initarg :text
    :initform (error "Query must have text.")
    :documentation "FORMAT string to convert to captcha query.")
   (string-types
    :initarg :string-types
    :initform (error "Query must have FORMAT args.")
    :documentation "Arguments of generator functions which will
produce values for captcha.")
   ))

(defclass query+ (query) ())
(defclass query- (query) ())
(defclass query* (query) ())
(defclass query/ (query) ())

;; DATABASE AND SUCH

(defun generate-query-database (&optional (data *query-strings*))
  (loop
   for query in data
   collect (let ((type   (first query))
		 (string (second query))
		 (args   (third query)))
	     (make-instance (intern (concatenate 'string
						 "QUERY"
						 (symbol-name type)))
			    :text string
			    :string-types args))))

(defvar *db* (generate-query-database))

;; PERFORM QUERY
;
;  Returns a string to print and a string to be compared against as the answer.
(defgeneric perform (q &optional string-args)
  (:documentation "PERFORM analyzes passed query and generates a
questionform and its
   cooresponding answerform."))

(defmacro perform-values (q fn string-args)
  (let ((s-a string-args))
    `(values (apply #'format (append (list nil (slot-value ,q 'text))
			      ,s-a))
             (format nil "~a" (reduce ,fn ,s-a)))))

(defmethod perform :around ((q query) &optional string-args)
  (call-next-method q (or string-args
			  (mapcar (lambda (x)
				    (typecase x
				      (list (apply (car x) (cdr x)))
				      (symbol (if (fboundp x)
						  (funcall x)
						  (error "Symbol ~A is not bound to function. Must be removed
from args list of query ~a" x q)))
				      (t x)))
				  (slot-value q 'string-types)))))

(defmethod perform ((q query/) &optional (string-args ()))
			 ; Avoid division by 0.
  (perform-values q #'/ (substitute-if (gennumber +numbermax+ 1)
#'zerop  string-args)))

(defmethod perform ((q query*) &optional (string-args ()))
  (perform-values q #'* string-args))

(defmethod perform ((q query+) &optional (string-args ()))
  (perform-values q #'+ string-args))

(defmethod perform ((q query-) &optional (string-args ()))
  (perform-values q #'- (sort (copy-list string-args) #'>)))

;; GENERATE-CAPTCHA
(defun generate-captcha (&key type (db *db*))
  "Produces a random CAPTCHA from DB. If TYPE is supplied, only CAPTCHAs of that
   type may be returned."
  (let ((db (remove-if (if type
			   (lambda (x)
			     (not (eq (type-of x) type)))
			   (constantly nil))
		       db)))
    (perform (elt db (random (length db))))))



~~~~~~~~~~

Cheers.

--
~ja.