I post my solution here.
It is ugly I know...
Examples:
"Maryh as as many grapes as tentacles in 0 + five octopuess she gets as many gr
apes as seas inthe world how many grapes does Mary have?"
=> "47"
"sbustract six BAZs rfom: two BAZs"
=> "-4"
"John has as many lemons as minutes in II hours. Sarah has as many
lemons as day s in IV weeks and Sarah givesa lemon for eac khing in
a deck of cards how many lemons does Sarah have?"
=> "24"
;;;;
(let ((rs (make-random-state t)))
(defun rand (n)
(random n rs)))
(defun choice (l)
(elt l (rand (length l))))
(defun fmt (&rest args)
(apply #'format nil args))
(defun mksym (&rest args)
(read-from-string (apply #'fmt args)))
(defmacro with-exprs (exprs vals &body body)
(let ((gensyms (mapcar #'(lambda (x) (gensym)) vals)))
`(destructuring-bind ,gensyms (list ,@vals)
(let ,(loop for x in exprs
for y in gensyms
nconcing
(if (eq (aref (symbol-name x) 0) #\=)
(let ((rest (subseq (symbol-name x) 1)))
(list (list (mksym "n~A" rest) `(first ,y))
(list (mksym "v~A" rest) `(second ,y))))
'()))
,@body))))
(defmacro defcaptcha (name args ret)
`(defun ,name ,args
(with-exprs ,args ,args
(choice ,ret))))
(defmacro fmt-lambda (args &rest body)
`#'(lambda ,args (fmt ,@body)))
(defcaptcha num ()
'(("zero" 0) ("0" 0)
("one" 1) ("I" 1)
("two" 2) ("II" 2)
("three" 3) ("III" 3)
("four" 4) ("IV" 4)
("five" 5) ("V" 5)
("six" 6) ("VI" 6)
("seven" 7) ("VII" 7)
("eight" 8) ("VIII" 8)
("nine" 9) ("IX" 9)
("ten" 10) ("X" 10)))
(defcaptcha bags ()
'("bags" "boxes" "packages" "packs" "sacks"))
(defcaptcha simple-num ()
`(,(num)
,(with-exprs (=n =m) ((num) (num))
(list (fmt "~A + ~A" nn nm) (+ vn vm)))
,(with-exprs (=n =m) ((num) (num))
(list (fmt "~A plus ~A" nn nm) (+ vn vm)))
,(with-exprs (=n =m) ((num) (num))
(list (fmt "~A times ~A" nn nm) (* vn vm)))
,(with-exprs (=n =m) ((num) (num))
(list (fmt "~A ~A of ~A" nn (bags) nm) (* vn vm)))
))
(defcaptcha as-many-as (a mul b)
`(,(fmt-lambda (x) "as many ~As as ~As in ~A ~A" x a mul b)
,(fmt-lambda (x) "a ~A for each ~A in ~A ~A" x a mul b)
))
(defcaptcha as-many-as* (a)
`(,(fmt-lambda (x) "as many ~A as ~A" x a)
))
(defun rand-word ()
(concatenate 'string
(loop for i from 1 to (+ (rand 8) 2)
collecting (code-char (+ (char-code #\A) (rand 26))))))
(defcaptcha rand-word-num ()
(let* ((w (rand-word))
(r (rand (length w)))
(s (subseq w r (1+ r)))
(c (aref w r)))
`((,(as-many-as s "the word" w) ,(count c w))
)))
(defcaptcha mul-num (=mul)
`((,(as-many-as "finger" nmul "hands") ,(* 5 vmul))
(,(as-many-as "day" nmul "weeks") ,(* 7 vmul))
(,(as-many-as "hour" nmul "days") ,(* 24 vmul))
(,(as-many-as "minute" nmul "hours") ,(* 60 vmul))
(,(as-many-as "tentacle" nmul "octopuses") ,(* 8 vmul))
(,(as-many-as "king" "a" "deck of cards") 4)
(,(as-many-as "sea" "the" "world" ) 7)
(,(as-many-as* "commandments") 10)
))
(defcaptcha fnum ()
(let ((n (simple-num)))
`((,(fmt-lambda (x) "~A ~As" (first n) x) ,(second n))
,(mul-num n)
,(rand-word-num))))
(defcaptcha how-many (p x)
`(,(fmt "how many ~As does ~A have?" x p)
,(fmt "now ~A has ..... ~As" p x)
,(fmt "~A has ..... ~As" p x)))
(defcaptcha fruit ()
'("apple" "banana" "grape" "pear" "peach" "plum"
"pineapple" "nectarine" "orange" "lemon" "apricot"))
(defcaptcha person ()
'("John" "Mary" "William" "Elizabeth" "James" "Thomas"
"Sarah" "Margaret" "Henry" "Joseph" "Beatrice"))
(defcaptcha to-get ()
'("get" "buy" "find" "create"))
(defcaptcha to-lose ()
'("lose" "sell" "give" "smoke" "burn" "throw" "trash"))
(defcaptcha he (p)
`(,p "he" "she"))
(defcaptcha foo ()
`("foo" "bar" "baz"))
(defcaptcha and-he-xs (p f)
`(,(fmt " and ~A ~As" (he p) (funcall f))
,(fmt " then ~A ~As" (he p) (funcall f))
,(fmt " ~A ~As" (he p) (funcall f))))
(defcaptcha and-name-xs (p f)
`(,(fmt " and ~A ~As" p (funcall f))
,(fmt " then ~A ~As" p (funcall f))
,(fmt " ~A ~As" p (funcall f))))
(defun another (gen &rest banned)
(do ((x (funcall gen) (funcall gen)))
((apply #'string/= x banned) x)))
(defcaptcha x-has-y (x n y)
`(,(fmt "~A has ~A" x (funcall n y))))
(defcaptcha x-has-y-2 (x n1 y1 n2 y2)
`(,(fmt "~A has ~A, ~A" x (funcall n1 y1) (funcall n2 y2))
,(fmt "~A has ~A, ~A" x (funcall n2 y2) (funcall n1 y1))))
(defcaptcha x1-x2-have-y1-y2 (x1 n1 y1 x2 n2 y2)
`(,(fmt "~A. ~A" (x-has-y x1 n1 y1) (x-has-y x2 n2 y2))
,(fmt "~A. ~A" (x-has-y x2 n2 y2) (x-has-y x1 n1 y1))))
(defcaptcha x-gets-y (x n y)
`(,(fmt "~A ~A" (and-he-xs x #'to-get) (funcall n y))))
(defcaptcha name-gets-y (x n y)
`(,(fmt "~A ~A" (and-name-xs x #'to-get) (funcall n y))))
(defcaptcha x-loses-y (x n y)
`(,(fmt "~A ~A" (and-he-xs x #'to-lose) (funcall n y))))
(defcaptcha name-loses-y (x n y)
`(,(fmt "~A ~A" (and-name-xs x #'to-lose) (funcall n y))))
(defcaptcha expr+ (=x =y)
(let* ((result (+ vx vy))
(fruit (fruit))
(name (person))
(fruit1 (another #'fruit fruit))
(name1 (another #'person name))
(rand-1 (first (fnum)))
(rand-2 (first (fnum)))
(foo (foo)))
`((,(fmt "~A plus ~A" (funcall nx foo) (funcall ny foo)) ,result)
(,(fmt "add ~A and ~A" (funcall nx foo) (funcall ny foo)) ,result)
(,(fmt "~A ~A ~A"
(x-has-y name nx fruit) (x-gets-y name ny fruit) (how-many name
fruit)) ,result)
(,(fmt "~A ~A ~A"
(x-has-y-2 name nx fruit rand-1 fruit1)
(x-gets-y name ny fruit) (how-many name fruit)) ,result)
(,(fmt "~A ~A ~A"
(x1-x2-have-y1-y2 name nx fruit name1 rand-1 fruit)
(name-gets-y name ny fruit) (how-many name fruit)) ,result)
(,(fmt "~A ~A ~A"
(x1-x2-have-y1-y2 name nx fruit name1 rand-1 fruit)
(name-gets-y name1 ny fruit) (how-many name fruit)) ,vx)
)))
(defcaptcha expr- (=x =y)
(let* ((result (- vx vy))
(fruit (fruit))
(name (person))
(fruit1 (another #'fruit fruit))
(name1 (another #'person name))
(rand-1 (first (fnum)))
(rand-2 (first (fnum)))
(foo (foo)))
`((,(fmt "~A minus ~A" (funcall nx foo) (funcall ny foo)) ,result)
(,(fmt "substract ~A from: ~A" (funcall ny foo) (funcall nx foo)) ,result)
(,(fmt "~A ~A ~A"
(x-has-y name nx fruit) (x-loses-y name ny fruit) (how-many name
fruit)) ,result)
(,(fmt "~A ~A ~A"
(x-has-y-2 name nx fruit rand-1 fruit1)
(x-loses-y name ny fruit) (how-many name fruit)) ,result)
(,(fmt "~A ~A ~A"
(x1-x2-have-y1-y2 name nx fruit name1 rand-1 fruit)
(name-loses-y name ny fruit) (how-many name fruit)) ,result)
(,(fmt "~A ~A ~A"
(x1-x2-have-y1-y2 name nx fruit name1 rand-1 fruit)
(name-loses-y name1 ny fruit) (how-many name fruit)) ,vx)
)))
(defcaptcha captcha ()
`(,(expr+ (fnum) (fnum))
,(expr- (fnum) (fnum))))
(defun lower-or-blank-p (x)
(or (lower-case-p x) (char= x #\Space)))
(defun obfuscate (str &optional (times 5))
(do ((str str) (i 0 (1+ i)) (l (1- (length str))))
((>= i times) str)
(let ((r (rand (1- l))))
(if (and (lower-or-blank-p (aref str r)) (lower-or-blank-p (aref
str (1+ r))))
(rotatef (aref str r) (aref str (1+ r)))))))
(defun generate-captcha ()
(with-exprs (=c) ((captcha))
(values (obfuscate nc) vc)))
;;;;
Happy captching!