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, [EMAIL PROTECTED] http://www.frank-buss.de, http://www.it4-systems.de _______________________________________________ Gardeners mailing list [email protected] http://www.lispniks.com/mailman/listinfo/gardeners
