From abrahamson.j at gmail.com Wed May 3 00:17:26 2006 From: abrahamson.j at gmail.com (Tel) Date: Tue, 2 May 2006 19:17:26 -0500 Subject: [quiz] [QUIZ #1] Solution by Joseph Abrahamson Message-ID: 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. From mb at bese.it Wed May 3 08:58:17 2006 From: mb at bese.it (Marco Baringer) Date: Wed, 03 May 2006 10:58:17 +0200 Subject: [quiz] [QUIZ #1] Solution by Joseph Abrahamson In-Reply-To: (Tel's message of "Tue, 2 May 2006 19:17:26 -0500") References: Message-ID: Tel writes: > ; -- DEPENDS on: > ; "Iterate":http://common-lisp.net/project/iterate/ this isn't true is it? i'm putting up all the solutions, as i get them, on the archive: http://common-lisp.net/project/quiz/quizzes/quiz1/quiz1.html -- -Marco Ring the bells that still can ring. Forget the perfect offering. There is a crack in everything. That's how the light gets in. -Leonard Cohen From mail at stuartsierra.com Wed May 3 15:07:04 2006 From: mail at stuartsierra.com (Stuart Sierra) Date: Wed, 03 May 2006 11:07:04 -0400 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra Message-ID: <4458C718.5070104@stuartsierra.com> 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 -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: captcha.lisp URL: From rnewman at tellme.com Wed May 3 15:58:57 2006 From: rnewman at tellme.com (Richard Newman) Date: Wed, 3 May 2006 08:58:57 -0700 Subject: [quiz] [QUIZ #1] Solution by Joseph Abrahamson In-Reply-To: References: Message-ID: <7D3ABC54-D918-4D74-8410-964B4175964C@tellme.com> Nice work, Marco! Very pretty :) -R On 3 May 2006, at 1:58 AM, Marco Baringer wrote: > i'm putting up all the solutions, as i get them, on the archive: > > http://common-lisp.net/project/quiz/quizzes/quiz1/quiz1.html From fusion at mx6.tiki.ne.jp Wed May 3 16:37:29 2006 From: fusion at mx6.tiki.ne.jp (Jean-Christophe Helary) Date: Thu, 4 May 2006 01:37:29 +0900 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra In-Reply-To: <4458C718.5070104@stuartsierra.com> References: <4458C718.5070104@stuartsierra.com> Message-ID: Is it possible to suggest that the CAPTCHA must be "easily" localizable ? By abstarcting the translatable strings for ex ? I would see another problem, namely the structure of the end string. This structure should be also abstracted to a certain point so that languages that do not use a structure similar to English (Japanese for ex) could still make use of the code. How hard would that be to have a "source" file including things like key=value for the localizable strings: initial-state-string_1="something in English" initial-state-string_1="something else in English" that would be parsed for display, and easily translatable to any other language and a "pattern" model that would be parsed to create the "generate- question" code ? (I am asking because I am not a programmer by any stretch of the imagination, I am just here to look at some short code and learn from it, and I don't intend to be disruptive with my questions, but it happens that I am also a translator in real life and that it is one of the reasons I got interested in Lisp) Sincere regards, Jean-Christophe Helary On 2006/05/04, at 0:07, Stuart Sierra wrote: > 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)))) > _______________________________________________ > quiz mailing list > quiz at common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/quiz From rnewman at tellme.com Wed May 3 17:11:55 2006 From: rnewman at tellme.com (Richard Newman) Date: Wed, 3 May 2006 10:11:55 -0700 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra In-Reply-To: References: <4458C718.5070104@stuartsierra.com> Message-ID: <692D94B8-E7EA-4AF3-BC71-4DAD66D328F5@tellme.com> > How hard would that be to have a "source" file including things > like key=value for the localizable strings: The way this is done in, say, Cocoa is to have a localisation file containing format strings: English: "what is ~S times ~S?" Greeble: "~S dfsiiikkkkkk ~S!" and bind the format strings at runtime after loading the appropriate file. Better still is to allow the order of arguments to change. I can't remember how Cocoa gets around this, but I'm sure it does. The key is to parameterise the output, and make all output conditional on the language. FORMAT is actually a reasonable way to do this, as one can always jump around in the input. -R From fusion at mx6.tiki.ne.jp Wed May 3 17:42:02 2006 From: fusion at mx6.tiki.ne.jp (Jean-Christophe Helary) Date: Thu, 4 May 2006 02:42:02 +0900 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra In-Reply-To: <692D94B8-E7EA-4AF3-BC71-4DAD66D328F5@tellme.com> References: <4458C718.5070104@stuartsierra.com> <692D94B8-E7EA-4AF3-BC71-4DAD66D328F5@tellme.com> Message-ID: On 2006/05/04, at 2:11, Richard Newman wrote: >> How hard would that be to have a "source" file including things >> like key=value for the localizable strings: > > The way this is done in, say, Cocoa is to have a localisation file > containing format strings: Well, I don't think thinking in terms of platform specific methods would do the trick. Just making sure that there is a part of the code that is easily understandable as localizable would do I suppose. When I write small scripts for my work, I always take care to separate string values from the code so that eventually, anyone could just take the code, identify the localizable strings, translate them and run the script natively. Also, in the case of Lisp, it looks like there is not "one" way to prepare an app for localization, but that also means that not a lot of people actually have localization issues in mind (by default). They sometimes have to consider the l10n issue, and it may be easier to deal with that in Lisp than in any other language, but it then looks like ad-hoc measures rather that strategies from the ground up. Regards, Jean-Christophe From mail at stuartsierra.com Wed May 3 18:49:29 2006 From: mail at stuartsierra.com (Stuart Sierra) Date: Wed, 03 May 2006 14:49:29 -0400 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra In-Reply-To: References: <4458C718.5070104@stuartsierra.com> Message-ID: <4458FB39.4060505@stuartsierra.com> Jean-Christophe Helary wrote: > Is it possible to suggest that the CAPTCHA must be "easily" localizable ? > By abstarcting the translatable strings for ex ? > that would be parsed for display, and easily translatable to any other > language Abrahamson and I put our strings into global variables, which is fairly easy to translate. The only problem is making (format "~r") multi-lingual, e.g. (format "~r" 2) => "deux" > and a "pattern" model that would be parsed to create the "generate- > question" code ? That's a bit trickier, especially when you get into issues of word order. FORMAT is pretty good at this, but I don't think you can change the order of the arguments, at least not without some ugly hacks. > I am also a translator in real life and that it is one of > the reasons I got interested in Lisp) See also CL-I10L at http://common-lisp.net/project/cl-l10n/ -Stuart From pjb at informatimago.com Wed May 3 19:38:54 2006 From: pjb at informatimago.com (Pascal Bourguignon) Date: Wed, 3 May 2006 21:38:54 +0200 Subject: [quiz] [QUIZ #1] Solution by Stuart Sierra In-Reply-To: <4458FB39.4060505@stuartsierra.com> References: <4458C718.5070104@stuartsierra.com> <4458FB39.4060505@stuartsierra.com> Message-ID: <17497.1742.312895.245849@thalassa.informatimago.com> Stuart Sierra writes: > Jean-Christophe Helary wrote: > > Is it possible to suggest that the CAPTCHA must be "easily" localizable ? > > By abstarcting the translatable strings for ex ? > > that would be parsed for display, and easily translatable to any other > > language > > Abrahamson and I put our strings into global variables, which is fairly > easy to translate. The only problem is making (format "~r") > multi-lingual, e.g. (format "~r" 2) => "deux" It cannot and it must not. Not until there's a new CL standard at least. But within the current standard, you can write: (format t "~/localization:format-number-in-french/" 2) ;; or: (format t "~V/localization:format-number-language/" (localization:language-index :french) 2) > > and a "pattern" model that would be parsed to create the "generate- > > question" code ? > > That's a bit trickier, especially when you get into issues of word > order. FORMAT is pretty good at this, but I don't think you can change > the order of the arguments, at least not without some ugly hacks. And you don't need, since FORMAT is pretty good at skipping around the argument list. > > I am also a translator in real life and that it is one of > > the reasons I got interested in Lisp) > > See also CL-I10L at http://common-lisp.net/project/cl-l10n/ > > -Stuart -- __Pascal Bourguignon__ http://www.informatimago.com/ THIS IS A 100% MATTER PRODUCT: In the unlikely event that this merchandise should contact antimatter in any form, a catastrophic explosion will result. From abrahamson.j at gmail.com Wed May 3 23:30:22 2006 From: abrahamson.j at gmail.com (Tel) Date: Wed, 3 May 2006 19:30:22 -0400 Subject: [quiz] Re: [QUIZ #1] Solution by Joseph Abrahamson Message-ID: > > From: Marco Baringer > > > ; -- DEPENDS on: > > ; "Iterate":http://common-lisp.net/project/iterate/ > > this isn't true is it? > > i'm putting up all the solutions, as i get them, on the archive: > > http://common-lisp.net/project/quiz/quizzes/quiz1/quiz1.html > > -- > -Marco > Ring the bells that still can ring. > Forget the perfect offering. > There is a crack in everything. > That's how the light gets in. > -Leonard Cohen > Oer, no, no it isn't. I used to have more looping constructs in it where I was using iterate, but then I removed them and just implemented in LOOP as to not need any extra libraries. You have my full and complete permission to change that when posted on the quiz site. Thanks. -- ~ja. -------------- next part -------------- An HTML attachment was scrubbed... URL: From abrahamson.j at gmail.com Thu May 4 00:51:13 2006 From: abrahamson.j at gmail.com (Tel) Date: Wed, 3 May 2006 19:51:13 -0500 Subject: [quiz] [QUIZ #1] Patching my own Stupidity Message-ID: Glancing over the cl-quiz site, more specifically the examples for my own script, I noticed I left a major bug in one of my macros. It was leaking when I tried to remove the 0s from division problems. Here's the fixed version, along with editing the wording to make one of the catpchas make sense being continuous (sort of) and removing that bogus dependency. Apologies for not catching this the first time ~~~~~~~~~~ ;;;;;;;;;;;;;; ; ; CAPTCHA ; ------- ; A Completely Automated Public Turing test ; to tell Computers and Humans Apart ; generator. ; Generates simple written arithmatic problems. ; ; 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 could 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 once-only ((&rest names) &body body) ;; Peter Seibel's Implementation of ONCE-ONLY ;; from PCL. (let ((gensyms (loop for n in names collect (gensym)))) `(let (,@(loop for g in gensyms collect `(,g (gensym)))) `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) , at body))))) (defmacro perform-values (q fn string-args) (once-only (q fn string-args) `(values (apply #'format (append (list nil (slot-value ,q 'text)) ,string-args)) (format nil "~a" (reduce ,fn ,string-args))))) (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)))))) ~~~~~~~~~~ -- ~ja. From pjb at informatimago.com Thu May 4 01:08:45 2006 From: pjb at informatimago.com (Pascal Bourguignon) Date: Thu, 4 May 2006 03:08:45 +0200 Subject: [quiz] [QUIZ #1] Patching my own Stupidity In-Reply-To: References: Message-ID: <17497.21533.39143.570311@thalassa.informatimago.com> Tel writes: > (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 could split ~r watch~:*~[es~;~:;es~] into ~r equal > group~:p, how many are in each group?" > (gennumber gennumber)))) Really guys, these are no captcha. Have a look at the student program in PAIP (norvig.com). It could easily solve these kind of problems, with very little or no added rules and code. Why remove the division by 0? On the contrary, this is something that could discriminate between a human and an computer, more than "what's the difference between three and two". Even if some human would answer: EDIV0. -- __Pascal Bourguignon__ http://www.informatimago.com/ Pour moi, la grande question n'a jamais ?t?: ?Qui suis-je? O? vais-je?? comme l'a formul? si adroitement notre ami Pascal, mais plut?t: ?Comment vais-je m'en tirer?? -- Jean Yanne From abrahamson.j at gmail.com Thu May 4 03:46:18 2006 From: abrahamson.j at gmail.com (Tel) Date: Wed, 3 May 2006 23:46:18 -0400 Subject: [quiz] [QUIZ #1] Patching my own Stupidity In-Reply-To: <17497.21533.39143.570311@thalassa.informatimago.com> References: <17497.21533.39143.570311@thalassa.informatimago.com> Message-ID: While you make a good point about it being much more difficult for programs to catch the DIV0, it's also hard to get a human to correctly write a response to it. Mathematically, 1/0 is meaningless. The best you can get is by taking limits to get answers like "does not exist" or "infinite", but you couldn't expect humans to answer that any better without a disclaimer (which could then, feasibly, be picked up by a program as well). Sure, it could be done, but is it worth it? Maybe. I do agree though -- my catpcha are sad -- but it'd be very much possible to write some more difficult ones. The deck one was a halfhearted attempt at such and is hardly the upper limit. I tried to make sure this was very easy to do, but didn't focus on actually doing it. My bad. All that being said, I'm not going to defend my code too much. It's very simplistic and I'm not good enough to push it too far past that within a reasonable amount of time. However, I'd love to see a more complete answer. On 5/3/06, Pascal Bourguignon wrote: > > Tel writes: > > (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 could split ~r watch~:*~[es~;~:;es~] > into ~r equal > > group~:p, how many are in each group?" > > (gennumber gennumber)))) > > Really guys, these are no captcha. Have a look at the student program > in PAIP (norvig.com). It could easily solve these kind of problems, > with very little or no added rules and code. > > > Why remove the division by 0? On the contrary, this is something that > could discriminate between a human and an computer, more than "what's > the difference between three and two". Even if some human would > answer: EDIV0. > > > -- > __Pascal Bourguignon__ http://www.informatimago.com/ > > Pour moi, la grande question n'a jamais ?t?: ?Qui suis-je? O? vais-je?? > comme l'a formul? si adroitement notre ami Pascal, mais plut?t: > ?Comment vais-je m'en tirer?? -- Jean Yanne > -- ~ja. -------------- next part -------------- An HTML attachment was scrubbed... URL: From mail at stuartsierra.com Thu May 4 17:13:19 2006 From: mail at stuartsierra.com (Stuart Sierra) Date: Thu, 04 May 2006 13:13:19 -0400 Subject: [quiz] [QUIZ #1] Patching my own Stupidity In-Reply-To: <17497.21533.39143.570311@thalassa.informatimago.com> References: <17497.21533.39143.570311@thalassa.informatimago.com> Message-ID: <445A362F.1000001@stuartsierra.com> Pascal Bourguignon wrote: > Really guys, these are no captcha. Have a look at the student program > in PAIP (norvig.com). It could easily solve these kind of problems, > with very little or no added rules and code. Okay, but what would you suggest? By definition, a CAPTCHA has to be something that can be solved by an algorithm. The best one can do, it seems, is add enough "noise" to the question to make it difficult to parse. -Stuart From pjb at informatimago.com Thu May 4 18:39:45 2006 From: pjb at informatimago.com (Pascal Bourguignon) Date: Thu, 4 May 2006 20:39:45 +0200 Subject: [quiz] [QUIZ #1] Patching my own Stupidity In-Reply-To: <445A362F.1000001@stuartsierra.com> References: <17497.21533.39143.570311@thalassa.informatimago.com> <445A362F.1000001@stuartsierra.com> Message-ID: <17498.19057.347604.888149@thalassa.informatimago.com> Stuart Sierra writes: > Pascal Bourguignon wrote: > > Really guys, these are no captcha. Have a look at the student program > > in PAIP (norvig.com). It could easily solve these kind of problems, > > with very little or no added rules and code. > > Okay, but what would you suggest? By definition, a CAPTCHA has to be > something that can be solved by an algorithm. The best one can do, it > seems, is add enough "noise" to the question to make it difficult to parse. Not at all. A CAPTCHA musn't be easily resolvable by an algorithm. A good CAPTCHA needs at least 90 IQ points. http://www.captcha.net/ http://en.wikipedia.org/wiki/Captcha Mori et al. published a paper in IEEE CVPR'03 detailing a method for defeating one of the most popular CAPTCHAs, EZ-Gimpy, which was tested as being 92% accurate. The same method was also shown to defeat the more complex and less-widely deployed Gimpy program with an accuracy of 33%. However, the existence of implementations of their algorithm in actual use is indeterminate at this time. For example a better captcha would be: You've got tree apples, you eat one. How many oranges are you left with? If you get as answer 2, you know you've got a program, or at least someone who cannot distinguish an apple from an orange, and who couldn't anyway answer: "What oranges?" But even there, a program like shldru would be able to ask "What oranges?". So the captcha would have to give a Turing Test, asking _several_ questions of different kinds, to be able to ascertain the essence of the "user". Let me see. If I ask you this: "Hiroshi Nohara was driving on the Road 66. He always felt uneasy when driving abroad. Can you explain me why?" Well, the information needed to give an explanation is available on the Internet. Only it's not present in OpenCyc, and browsing the web to gather it, and making the right inferences, would take more time than what a human would need to answer. As a human, can you answer that question? What I'm trying to do here, is to build questions which are easy to answer, given common knowledge which is obvious for human, but which is not so well formalized and accessible in machine readable form. -- __Pascal Bourguignon__ http://www.informatimago.com/ "Indentation! -- I will show you how to indent when I indent your skull!" From foones at gmail.com Thu May 4 16:42:21 2006 From: foones at gmail.com (Pablo Barenbaum) Date: Thu, 4 May 2006 13:42:21 -0300 Subject: [quiz] Another solution Message-ID: 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 , 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)))) (defmacro defcaptcha (name args ret) `(defun ,name ,args (with-exprs ,args ,args (choice ,ret)))) (defmacro fmt-lambda (args &rest body) `#'(lambda ,args (fmt , at 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! From mb at bese.it Fri May 5 10:33:32 2006 From: mb at bese.it (Marco Baringer) Date: Fri, 05 May 2006 12:33:32 +0200 Subject: [quiz] quiz1 non-summary Message-ID: just to let people know that, unlike perl's quiz of the week or rubyquiz i don't think i'm going to write up an explicit summary report over and above what's already on the site. -- -Marco Ring the bells that still can ring. Forget the perfect offering. There is a crack in everything. That's how the light gets in. -Leonard Cohen From mb at bese.it Sun May 7 17:12:46 2006 From: mb at bese.it (Marco Baringer) Date: Sun, 07 May 2006 19:12:46 +0200 Subject: [quiz] Quiz #2 - Argh! The parenthesis! They burn my eyes! Message-ID: Argh! The parenthesis! They burn my eyes! ----------------------------------------- Overview ======== One of the more common complaints people have against the lisp language family is the abbundance of parenthesis is source code. "To hell with 'em!" I hear you say, and you're right, but it still makes for an interesting quiz. Goal ==== You're going to prove that common lisp really is the "Programmable Programming Language"[1] by changing the syntax to use less parenthesis. Write a function quiz2::read-off-side which allows python-style whitspace-sensitive source code (this is sometimes called the "off side" rule[2]). This function will be bound to the #! dispatching macro character and so must have this api (the test suite assumes this): (quiz2::read-off-side stream subchar parameter) => form The easiest way to explain how the syntax works is to show it. Example 1: #! when t (do-stuff) !# => (progn (when t (do-stuff))) Example 2: 1:#! 2:cond 3: (zerop a) 4: (write-line "A is zero.") 5: (plusp a) 6: (write-line "A is positive.") 7: t 8: (write-line "A is negative.") 9:(write-line "Done.") b:!# => (progn (cond ((zerop a) (write-line "A is zero.")) ((plusp a) (write-line "A is positive.")) (t (write-line "A is negative."))) (write-line "Done.")) If you doubts on how a form should be parsed see the print-off-sides function in the test suite. Test Suite ========== A test suite is available at: http://common-lisp.net/project/quiz/quizzes/quiz2/test.lisp You'll need to load your code before that file, it assumes the quiz2 package, and read-off-side function, already exist. After you've loaded the file execute (5am:run! :quiz2) to run the test suite, it uses my FiveAM[3] test suite. If you want to rewrite the test suite using another framework go ahead, I'll add a link to your rewrite here. [1] - John Foderaro, CACM, September 1991 [2] - http://en.wikipedia.org/wiki/Off-side_rule [3] - http://common-lisp.net/project/bese/FiveAM.html -- -Marco Ring the bells that still can ring. Forget the perfect offering. There is a crack in everything. That's how the light gets in. -Leonard Cohen From foones at gmail.com Mon May 8 21:38:38 2006 From: foones at gmail.com (Pablo Barenbaum) Date: Mon, 8 May 2006 18:38:38 -0300 Subject: [quiz] (Partial?) solution to the second quiz Message-ID: I post a partial solution to the off-side-reader quiz. I say "partial" because, even though it reads in off-side mode, I'm not sure if it works as it is supposed in every case, i.e.: - what about blank lines? - what about comments? - the !# is supposed to be alone in a single line? - ... I'm afraid I tend overuse format and loop. It is also possibly very inefficient: it generates a new string with the "correct", inherent, parens made explicit, then reads it. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage :quiz2) (in-package :quiz2) (defvar *blanks* '(#\Space #\Tab #\Newline #\Return)) (defun distance (str prev-dist) (if (zerop (length (string-left-trim *blanks* str))) prev-dist (do ((col 0 (1+ col))) ((not (member (aref str col) *blanks* :test #'char=)) col)))) (defun read-off-side-to-string (stream) (let ((prev-line "") (prev-dists '()) (prev-dist 0)) (with-output-to-string (s) (format s "(progn ") (loop for line = (read-line stream nil 'eof) while (not (or (eq line 'eof) (string= line "!#"))) do (let ((dist (distance line prev-dist))) (when (> dist prev-dist) (push dist prev-dists) (format s "(")) (format s "~A~%" prev-line) (loop while (and (not (null prev-dists)) (< dist (car prev-dists))) do (pop prev-dists) do (format s ")")) (setf prev-line line) (setf prev-dist dist))) (format s "~A~%" prev-line) (loop while (not (null prev-dists)) do (pop prev-dists) do (format s ")")) (format s ")~%")))) (defun read-off-side (stream c n) (nth-value 0 (read-from-string (read-off-side-to-string stream)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From foones at gmail.com Mon May 8 23:31:04 2006 From: foones at gmail.com (Pablo Barenbaum) Date: Mon, 8 May 2006 20:31:04 -0300 Subject: [quiz] Shamefully... Message-ID: The "partial"-solution was not a solution at all! Sorry about the noise... From mb at bese.it Tue May 9 09:21:52 2006 From: mb at bese.it (Marco Baringer) Date: Tue, 09 May 2006 11:21:52 +0200 Subject: [quiz] Re: (Partial?) solution to the second quiz References: Message-ID: "Pablo Barenbaum" writes: > I post a partial solution to the off-side-reader quiz. > I say "partial" because, even though it reads in off-side mode, > I'm not sure if it works as it is supposed in every case, i.e.: > - what about blank lines? ignore them. > - what about comments? interesting question. i'd say that you can just ignore both ; and #| style comments. handling them makes for a good bonus question. > - the !# is supposed to be alone in a single line? yes. i assumed, though did not explicitly state, that the opening #! and closing !# would be be themselves an a single line. > I'm afraid I tend overuse format and loop. :) > It is also possibly very inefficient: it generates a new string > with the "correct", inherent, parens made explicit, then reads it. that sounds like a perfectly good technique to me, don't worry about the efficency of it. -- -Marco Ring the bells that still can ring. Forget the perfect offering. There is a crack in everything. That's how the light gets in. -Leonard Cohen From boldyrev+nospam at cgitftp.uiggm.nsc.ru Tue May 9 17:48:56 2006 From: boldyrev+nospam at cgitftp.uiggm.nsc.ru (Ivan Boldyrev) Date: Wed, 10 May 2006 00:48:56 +0700 Subject: [quiz] [SPOILER] Quiz #2 Message-ID: <8917j3-l34.ln1@ibhome.cgitftp.uiggm.nsc.ru> I can't run test because FiveAM from Gentoo portage (1.2.3) has no FOR-ALL (or is it from other package?). But I tested it manually. ---------------------------------------------------------------------- ;;; Copyright (C) 2006 Ivan Boldyrev ;;; This code is freely redistributable. (cl:defpackage #:quiz2 (:use #:cl)) (cl:in-package #:quiz2) (defvar *stack* nil "Stack for parsed objects") (defun tab-ws (pos) #-dont-blame-tabspace(warn "Tabular is found at pos ~S" pos) (* 8 (floor (+ pos 8) 8))) (defun count-ws (input-stream) (loop :for cnt := 0 :then (case char ((#\Space) (1+ cnt)) ((#\Tab) (tab-ws cnt)) ((#\Return #\Linefeed) ;; Space-only line! Just ignore it (return-from count-ws (count-ws input-stream))) (otherwise (unread-char char input-stream) (return-from count-ws cnt))) :for char := (read-char input-stream))) (defun combine-lines (first rest) (cons first (nreverse rest))) (defun reduce-forms (offset) (let ((tail (cdr (pop *stack*)))) (if (> offset (car (first *stack*))) (push (list offset (nreverse tail)) *stack*) (let ((first (pop (cdr (first *stack*))))) (progn (push (combine-lines first tail) (cdr (first *stack*))) *stack*))))) (defun read-the-line (input-stream) (let ((space-offset (count-ws input-stream)) (data (read-preserving-whitespace input-stream))) ;; Perform all reductions (loop :while (and (rest *stack*) (< space-offset (car (first *stack*)))) :do (reduce-forms space-offset)) (cond ((and (symbolp data) (string= (symbol-name data) "!#")) (throw 'thats-all-folks (cons 'progn (loop :while (rest *stack*) :do (reduce-forms 0) :finally (return (nreverse (cdr (first *stack*)))))))) ((and *stack* (= space-offset (car (first *stack*)))) (push data (cdr (first *stack*))) *stack*) (t (push (cons space-offset (list data)) *stack*))))) (defun read-off-side (stream subchar parameter) (declare (ignore subchar parameter)) (let ((*stack* nil)) ;; Catch is duty hack here. Do not repeat at home! (catch 'thats-all-folks (loop (read-the-line stream))))) ---------------------------------------------------------------------- -- Ivan Boldyrev Ok people, move along, there's nothing to see here. From foones at gmail.com Wed May 10 19:19:13 2006 From: foones at gmail.com (Pablo Barenbaum) Date: Wed, 10 May 2006 16:19:13 -0300 Subject: [quiz] A (hopefully) working solution Message-ID: A solution that seems to work =) - it ignores blank lines - it ignores comments starting with ; - it expects the !# to be alone in a single line - it gets screwed up with multiline strings and #| ... |# comments, and possibly with most extensions to the reader - I keep overusing format and loop =b ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar *blanks* '(#\Space #\Tab #\Newline #\Return)) (defvar *tabs* '(#\Tab)) (defvar *comment-markers* `(#\;)) (defvar *tab-width* 8) (defun width (char) (if (member char *tabs*) *tab-width* 1)) (defun distance (str) (do ((col 0 (+ col (width (aref str col))))) ((not (member (aref str col) *blanks* :test #'char=)) col))) (defun trim-blanks (str) (string-trim *blanks* str)) (defun blank-line-p (str) (let ((trimmed (trim-blanks str))) (or (string= "" trimmed) (member (aref trimmed 0) *comment-markers* :test #'char=)))) (defun last-line-p (line) (or (eq line 'eof) (string= (trim-blanks line) "!#"))) (defun read-off-side-to-string (stream) (let ((prev-lines (list (list "PROGN"))) (prev-dists (list -1)) (prev-dist -1)) (flet ((pop-expr () (let* ((tail (pop prev-lines)) (head (pop (first prev-lines)))) (push (format nil "(~A~%~{~A~%~})" head (nreverse tail)) (first prev-lines)))) (next-line () (loop for line = (read-line stream nil 'eof) while (and (not (eq line 'eof)) (blank-line-p line)) finally (return line)))) (with-output-to-string (s) (loop for line = (next-line) while (not (last-line-p line)) do (let ((dist (distance line))) (when (> dist prev-dist) (push dist prev-dists) (push (list) prev-lines)) (loop while (and (not (null (cdr prev-dists))) (< dist (car prev-dists))) do (pop prev-dists) do (pop-expr)) (push line (first prev-lines)) (setf prev-dist dist))) (loop while (not (null (cdr prev-dists))) do (pop prev-dists) do (pop-expr)) (format s "~{~A~%~}" (nreverse (pop prev-lines))))))) (defun read-off-side (stream c n) (let ((r (nth-value 0 (read-from-string (read-off-side-to-string stream))))) (if (atom r) (list r) r))) From mail at stuartsierra.com Thu May 11 19:10:57 2006 From: mail at stuartsierra.com (Stuart Sierra) Date: Thu, 11 May 2006 15:10:57 -0400 Subject: [quiz] quiz 2 without a stack? Message-ID: <44638C41.2050806@stuartsierra.com> I don't have a solution, but I'm curious: Is it possible to solve Quiz #2 in a purely functional way, without a temporary "stack" variable? -Stuart From boldyrev+nospam at cgitftp.uiggm.nsc.ru Fri May 12 04:20:32 2006 From: boldyrev+nospam at cgitftp.uiggm.nsc.ru (Ivan Boldyrev) Date: Fri, 12 May 2006 11:20:32 +0700 Subject: [quiz] Re: quiz 2 without a stack? References: <44638C41.2050806@stuartsierra.com> Message-ID: On 9472 day of my life Stuart Sierra wrote: > I don't have a solution, but I'm curious: Is it possible to solve Quiz > #2 in a purely functional way, without a temporary "stack" variable? > -Stuart Use temporary "accumulator" variable :) -- Ivan Boldyrev Perl is a language where 2 x 2 is not equal to 4.