4 May 2006 18:42

## Another solution

```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)

(defmacro with-exprs (exprs vals &body body)
(let ((gensyms (mapcar #'(lambda (x) (gensym)) vals)))
`(destructuring-bind ,gensyms (list , <at> 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))))
'()))
, <at> body))))

`(defun ,name ,args
(with-exprs ,args ,args
(choice ,ret))))

(defmacro fmt-lambda (args &rest body)
`#'(lambda ,args (fmt , <at> body)))

'(("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)))

'("bags" "boxes" "packages" "packs" "sacks"))

`(,(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)))
))

`(,(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)
))

`(,(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))))))

(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))
)))

`((,(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)
))

(let ((n (simple-num)))
`((,(fmt-lambda (x) "~A ~As" (first n) x) ,(second n))
,(mul-num n)
,(rand-word-num))))

`(,(fmt "how many ~As does ~A have?" x p)
,(fmt "now ~A has ..... ~As" p x)
,(fmt "~A has ..... ~As" p x)))

'("apple" "banana" "grape" "pear" "peach" "plum"
"pineapple" "nectarine" "orange" "lemon" "apricot"))

'("John" "Mary" "William" "Elizabeth" "James" "Thomas"
"Sarah" "Margaret" "Henry" "Joseph" "Beatrice"))

'("lose" "sell" "give" "smoke" "burn" "throw" "trash"))

`(,p "he" "she"))

`("foo" "bar" "baz"))

`(,(fmt " and ~A ~As" (he p) (funcall f))
,(fmt " then ~A ~As" (he p) (funcall f))
,(fmt " ~A ~As" (he p) (funcall 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)))

`(,(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))))

`(,(fmt "~A ~A" (and-he-xs x #'to-get) (funcall n y))))

`(,(fmt "~A ~A" (and-name-xs x #'to-get) (funcall n y))))

`(,(fmt "~A ~A" (and-he-xs x #'to-lose) (funcall n y))))

`(,(fmt "~A ~A" (and-name-xs x #'to-lose) (funcall n 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)
)))

(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)
)))

`(,(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)))))))