[Gardeners] Gardeners Digest, Vol 5, Issue 17
Pablo Barenbaum
foones at gmail.com
Sun Apr 23 10:04:10 CDT 2006
Maybe the contest could be "lispier" if the challenges
were meta-challenges. E.g.: provide an interface to
extend Lisp with certain language feature.
The test cases then would be normal programs written
in the extended dialect.
On 4/23/06, gardeners-request at lispniks.com
<gardeners-request at lispniks.com> wrote:
> Send Gardeners mailing list submissions to
> gardeners at lispniks.com
>
> To subscribe or unsubscribe via the World Wide Web, visit
> http://www.lispniks.com/mailman/listinfo/gardeners
> or, via email, send a message with subject or body 'help' to
> gardeners-request at lispniks.com
>
> You can reach the person managing the list at
> gardeners-owner at lispniks.com
>
> When replying, please edit your Subject line so it is more specific
> than "Re: Contents of Gardeners digest..."
>
>
> Today's Topics:
>
> 1. Re: FAQ updated (Jean-Christophe Helary)
> 2. Lisp contest (Pablo Barenbaum)
> 3. Re: Lisp contest (Frank Buss)
> 4. Re: Lisp contest (Frank Buss)
>
>
> ----------------------------------------------------------------------
>
> Message: 1
> Date: Sun, 23 Apr 2006 00:07:37 +0900
> From: Jean-Christophe Helary <fusion at mx6.tiki.ne.jp>
> Subject: Re: [Gardeners] FAQ updated
> To: Tending the Lisp Garden <gardeners at lispniks.com>
> Message-ID: <F15D47ED-7BF4-44EF-8E98-4A8C4066AA14 at mx6.tiki.ne.jp>
> Content-Type: text/plain; charset=US-ASCII; delsp=yes; format=flowed
>
> I don't suppose somebody else is interested in this activity so I
> started without really asking: I am currently translating the FAQ to
> French.
>
> Also, since I see there are a few French people on the list, I was
> wondering if French tutorial/books/translations were available for
> linking from the Faq in addition to the English references, that's
> for the French Faq obviously :)
>
> Jean-Christophe
>
> ps: on a related note, are there documents (even long ones) available
> for translation ?
>
> On 2006/04/22, at 11:06, Peter Seibel wrote:
>
> > On Apr 21, 2006, at 7:03 PM, Jean-Christophe Helary wrote:
> >
> >> Where is the source of the 2 files ?
> >
> > Just change the .html to .txt
> >
> > -Peter
> >
> > --
> > Peter Seibel * peter at gigamonkeys.com
> > Gigamonkeys Consulting * http://www.gigamonkeys.com/
> > Practical Common Lisp * http://www.gigamonkeys.com/book/
> >
> >
> > _______________________________________________
> > Gardeners mailing list
> > Gardeners at lispniks.com
> > http://www.lispniks.com/mailman/listinfo/gardeners
> >
>
>
>
> ------------------------------
>
> Message: 2
> Date: Sat, 22 Apr 2006 16:29:03 -0300
> From: "Pablo Barenbaum" <foones at gmail.com>
> Subject: [Gardeners] Lisp contest
> To: gardeners at lispniks.com
> Message-ID:
> <e6c1e9870604221229m5b6b3320j9215ca6ee444cdad at mail.gmail.com>
> Content-Type: text/plain; charset=ISO-8859-1
>
> I had the idea that some kind of "Lisp contest" could be
> good for getting the community together.
>
> The rest is left as an exercise to the interested reader. ;-)
>
>
> ------------------------------
>
> Message: 3
> Date: Sat, 22 Apr 2006 22:32:11 +0200
> From: Frank Buss <fb at frank-buss.de>
> Subject: Re: [Gardeners] Lisp contest
> To: gardeners at lispniks.com
> Message-ID: <zeo2rflnvu1a.1v72sfzm4jw5i$.dlg at 40tude.net>
> Content-Type: text/plain; charset="us-ascii"
>
> Pablo Barenbaum wrote:
>
> > I had the idea that some kind of "Lisp contest" could be
> > good for getting the community together.
>
> Good idea. Could be something like this: http://www.rubyquiz.com/
>
> I've tried the maze quiz, without looking to the Ruby solutions:
>
> CL-USER > (test)
> #################################
> #. #... # # #... #
> #.### #.#.### # # ### # ###.#.# #
> #.# #.#.# # # # # #...#.# #
> #.#####.#.# ### # # ### #.###.# #
> #.#.....#.# # # #.# #.# #
> #.#.#####.##### #########.# #.###
> #... #.....# #......... #...#
> # ######### #.###.#############.#
> # # # #..... # # # .#
> ### # ### ######### # # # # # #.#
> # # # # # # # # #.#
> # ### # ### ### ####### # #####.#
> # # # # # # # #.....#
> # # ######### ####### ### #.#####
> # # # # # #.# #
> # ### # ############# # ###.### #
> # # # # # # # # #.....#
> # # # # # ### # ####### # #####.#
> # # # # # .#
> #################################
>
>
>
> Don't look at the source below, if you like to create your own solution. It
> could be simplified and written with less redundancy by refactoring the
> main concept (because the generator and the solver is basicly the same) and
> could be enhanced easily for 3D and higher dimension mazes.
>
>
>
>
>
>
>
>
>
>
> (defun create-maze (logical-width logical-height)
> "Create a so called 'perfect maze'"
> (let* ((maze-width (1+ (* 2 logical-width)))
> (maze-height (1+ (* 2 logical-height)))
> (maze (make-array (list maze-width maze-height)
> :initial-element nil))
> (x (1+ (* 2 (random logical-width))))
> (y (1+ (* 2 (random logical-height))))
> (stack '())
> (size (* logical-width logical-height))
> (visited 0))
> ;; fill with walls
> (loop for y from 0 below maze-height do
> (loop for x from 0 below maze-width do
> (setf (aref maze x y) :wall)))
> ;; delete markers
> (loop for y from 1 below maze-height by 2 do
> (loop for x from 1 below maze-width by 2 do
> (setf (aref maze x y) nil)))
> ;; break walls
> (loop while (< visited size) do
> (unless (aref maze x y)
> (setf (aref maze x y) :visited)
> (incf visited))
> (let ((directions '()))
> (loop for (x . y) in `((,(+ x 2) . ,y)
> (,(- x 2) . ,y)
> (,x . ,(+ y 2))
> (,x . ,(- y 2)))
> do (when (and (>= x 0)
> (>= y 0)
> (< x maze-width)
> (< y maze-height)
> (not (aref maze x y )))
> (push (cons x y) directions)))
> (if (car directions)
> (let* ((direction (elt directions
> (random (length directions))))
> (new-x (car direction))
> (new-y (cdr direction)))
> (push (cons x y) stack)
> (setf (aref maze
> (ash (+ x new-x) -1)
> (ash (+ y new-y) -1)) nil)
> (setf x new-x
> y new-y))
> (let ((dir (pop stack)))
> (setf x (car dir)
> y (cdr dir))))))
> ;; delete markers
> (loop for y from 1 below maze-height by 2 do
> (loop for x from 1 below maze-width by 2 do
> (setf (aref maze x y) nil)))
> maze))
>
> (defun print-maze (maze)
> "Print a maze"
> (destructuring-bind (maze-width maze-height) (array-dimensions maze)
> (loop for y from 0 below maze-height do
> (loop for x from 0 below maze-width do
> (princ (case (aref maze x y)
> (:path ".")
> (:wall "#")
> (t " "))))
> (terpri))))
>
> (defun solve-maze (maze)
> "Return t, if maze is solved (filled with :path) or nil if not solvable"
> (destructuring-bind (maze-width maze-height) (array-dimensions maze)
> (let ((stack '())
> (size (* maze-width maze-height))
> (visited 0)
> (x 1)
> (y 1)
> (end-x (- maze-width 2))
> (end-y (- maze-height 2)))
> (loop while (< visited size) do
> (unless (aref maze x y)
> (setf (aref maze x y) :path)
> (incf visited))
> (when (and (= end-x x) (= end-y y)) (return-from solve-maze t))
> (let ((directions '()))
> (loop for (x . y) in `((,(1+ x) . ,y)
> (,(1- x) . ,y)
> (,x . ,(1+ y))
> (,x . ,(1- y)))
> do (when (and (>= x 0)
> (>= y 0)
> (< x maze-width)
> (< y maze-height)
> (not (aref maze x y )))
> (push (cons x y) directions)))
> (if (car directions)
> (let* ((direction (elt directions
> (random (length directions))))
> (new-x (car direction))
> (new-y (cdr direction)))
> (push (cons x y) stack)
> (setf x new-x
> y new-y))
> (let ((dir (pop stack)))
> (unless dir (return-from solve-maze))
> (setf (aref maze x y) :dead-end)
> (setf x (car dir)
> y (cdr dir)))))))))
>
> (defun test ()
> (let ((maze (create-maze 16 10)))
> (solve-maze maze)
> (print-maze maze)))
>
> --
> Frank Buss, fb at frank-buss.de
> http://www.frank-buss.de, http://www.it4-systems.de
>
>
>
> ------------------------------
>
> Message: 4
> Date: Sun, 23 Apr 2006 02:28:58 +0200
> From: Frank Buss <fb at frank-buss.de>
> Subject: Re: [Gardeners] Lisp contest
> To: gardeners at lispniks.com
> Message-ID: <gmbfcix651j8$.mtcbhbwk06tb$.dlg at 40tude.net>
> Content-Type: text/plain; charset="us-ascii"
>
> Frank Buss wrote:
>
> > could be enhanced easily for 3D and higher dimension mazes.
>
> done:
>
> (defun fill-maze (maze start add value dimensions &optional (index nil))
> (let ((max (car dimensions)))
> (if max
> (let ((rest (cdr dimensions)))
> (loop for i from start below max by add do
> (fill-maze maze start add value rest (cons i index))))
> (setf (apply #'aref maze (reverse index)) value))))
>
> (defun get-possible-directions (maze ofs position maze-dimensions)
> (let ((dimension-count (length maze-dimensions)))
> (loop for i from 0 below dimension-count
> with directions = '()
> finally (return directions) do
> (loop for ofs from (* -1 ofs) to (* 1 ofs) by (* 2 ofs)
> with add do
> (setf add t)
> (let ((direction
> (loop for j from 0 below dimension-count
> for p in position
> for d in maze-dimensions collect
> (let ((coord
> (if (= i j)
> (+ ofs p)
> p)))
> (when (or (< coord 0)
> (= coord d))
> (setf add nil)
> (loop-finish))
> coord))))
> (when (and add (not (apply #'aref maze direction)))
> (push direction directions)))))))
>
> (defun create-maze (dimensions)
> "Create a so called 'perfect maze'"
> (let* ((maze-dimensions (loop for i in dimensions collect (1+ (* 2 i))))
> (maze (make-array maze-dimensions
> :initial-element nil))
> (position (loop for i in dimensions collect (1+ (* 2 (random
> i)))))
> (stack '())
> (size (* (reduce #'* dimensions)))
> (visited 0))
> ;; fill with walls
> (fill-maze maze 0 1 :wall maze-dimensions)
> ;; delete markers
> (fill-maze maze 1 2 nil maze-dimensions)
> ;; break walls
> (loop while (< visited size) do
> (unless (apply #'aref maze position)
> (setf (apply #'aref maze position) :visited)
> (incf visited))
> (let ((directions (get-possible-directions maze 2 position
> maze-dimensions)))
> (if (car directions)
> (let* ((new-position (elt directions
> (random (length directions)))))
> (push new-position stack)
> (setf (apply #'aref maze (loop for i in new-position
> for j in position
> collect (ash (+ i j) -1)))
> nil)
> (setf position new-position))
> (setf position (pop stack)))))
> ;; delete markers
> (fill-maze maze 1 2 nil maze-dimensions)
> maze))
>
> (defun print-maze-layer (maze dimensions &optional (index nil))
> (let ((max (car dimensions)))
> (if (> (length dimensions) 2)
> (let ((rest (cdr dimensions)))
> (loop for i from 0 below max do
> (print-maze-layer maze rest (cons i index))))
> (loop for y from 0 below (cadr dimensions) do
> (loop for x from 0 below (car dimensions) do
> (princ (case (apply #'aref maze (append index (list x)
> (list y)))
> (:path ".")
> (:wall "#")
> (t " "))))
> (terpri)))
> (terpri)))
>
> (defun print-maze (maze)
> "Print a maze"
> (print-maze-layer maze (array-dimensions maze)))
>
> (defun solve-maze (maze)
> "Return t, if maze is solved (filled with :path) or nil if not solvable"
> (let* ((maze-dimensions (array-dimensions maze))
> (position (loop for i in maze-dimensions collect 1))
> (end (loop for i in maze-dimensions collect (- i 2)))
> (stack '())
> (size (* (reduce #'* maze-dimensions)))
> (visited 0))
> (loop while (< visited size) do
> (unless (apply #'aref maze position)
> (setf (apply #'aref maze position) :path)
> (incf visited))
> (when (equalp position end) (return-from solve-maze t))
> (let ((directions (get-possible-directions maze 1 position
> maze-dimensions)))
> (if (car directions)
> (let* ((new-position (elt directions
> (random (length directions)))))
> (push position stack)
> (setf position new-position))
> (let ((new-position (pop stack)))
> (unless new-position (return-from solve-maze))
> (setf (apply #'aref maze position) :dead-end)
> (setf position new-position)))))))
>
> (defun test-2d ()
> (let ((maze (create-maze '(16 10))))
> (solve-maze maze)
> (print-maze maze)))
>
> (defun test-3d ()
> (let ((maze (create-maze '(2 16 10))))
> (solve-maze maze)
> (print-maze maze)))
>
> (defun test-4d ()
> (let ((maze (create-maze '(3 3 5 4))))
> (solve-maze maze)
> (print-maze maze)))
>
>
> --
> Frank Buss, fb at frank-buss.de
> http://www.frank-buss.de, http://www.it4-systems.de
>
>
>
> ------------------------------
>
> _______________________________________________
> Gardeners mailing list
> Gardeners at lispniks.com
> http://www.lispniks.com/mailman/listinfo/gardeners
>
>
> End of Gardeners Digest, Vol 5, Issue 17
> ****************************************
>
--
Pablo Barenbaum
http://cubonegro.orgfree.com
More information about the Gardeners
mailing list