Robert Munyer is "Fastest Codeslinger of 2009"
Submitted by clintc on March 24, 2009 - 3:34pm
Congratulations to Robert Munyer. He solved our 2009 programming problem in 1 hour and 22 minutes beating out the other contestants. Click the story link to see the code.
Brad from Main Street Softworks presents the Asus Netbook 1000 prize to Robert.
Here is the winning code in common lisp with the problem maze embedded:
(defvar *str* '("..........................................#...................................." "########...#######..##....##.####.#########...#############...................." "##.....##.##.....##.###...##.####....##..............###......................." "##.....##.##.....##.####..##..##.....##................########................" "##.....##.##.....##.##.##.##.##......##..........#####....#...................." "##.....##.##.....##.##..####.........##.....####..........#...................." "##.....##.##.....##.##...###.........##........###############################." "########...#######..##....##.........##............#..........................." "...................................................#..........#######.........." ".........###########################################..........................." ".....................................................##########################" "####################################################..........................." ".....................................................##########################" "########.....###....##....##.####..######.....####.############################" "##.....##...##.##...###...##..##..##....##....####............................." "##.....##..##...##..####..##..##..##..........####............................." "########..##.....##.##.##.##..##..##...........##.............................." "##........#########.##..####..##..##..........................................." "##........##.....##.##...###..##..##....##....####............................." "##........##.....##.##....##.####..######.....####............................." ".........................#........................#############################" "........#########################################.......#######################" "..............................................................................." ".#############################################################################." "..###########################################################################.." "...########################################################################..##" "....######################################################################..###" ".....####################################################################..####" "......##################################################################......." ".......################################################################....####" "........##############################################################...######" ".........############################################################...#######" ".###################################################################..........." "..............................................................................." ".##############################################################################" "..............................................................................." "##############################################################################." "..............................................................................." ".##############################################################################" "...............................................................................")) (defvar a (make-array '(40 79) :element-type 'standard-char)) (dotimes (row 40) (let ((str (nth row *str*))) (dotimes (col 79) (setf (aref a row col) (char str col))))) (defvar b (make-array '(40 79))) (dotimes (row 40) (dotimes (col 79) (setf (aref b row col) (list (list row col) nil nil)))) (setf (second (aref b 0 0)) 0) (defvar b2 (make-array (list (* 40 79)) :displaced-to b)) (let ((q (list (aref b 0 0)))) (prog () strt (if (null q) (return)) (let* ((q2 (sort (copy-list q) #'< :key #'second)) (ce (first q2)) (cr (first ce)) (x (first cr)) (x-1 (1- x)) (x+1 (1+ x)) (y (second cr)) (y-1 (1- y)) (y+1 (1+ y)) (cd `((,x-1 ,y-1) (,x-1 ,y) (,x-1 ,y+1) (,x ,y-1) (,x ,y) (,x ,y+1) (,x+1 ,y-1) (,x+1 ,y) (,x+1 ,y+1))) (ns (remove-if #'(lambda (cr) (let ((r (first cr)) (c (second cr))) (not (and (<= 0 r 39) (<= 0 c 78) (char= (aref a r c) #\.))))) cd))) (let ((q3 nil) (cs (1+ (second ce)))) (dolist (nb (mapcar #'(lambda (nc) (aref b (first nc) (second nc))) ns)) (let ((nc (second nb))) (when (or (null nc) (> nc cs)) (setf (second nb) cs) (setf (third nb) (first ce)) (push nb q3)))) (setq q (remove-duplicates (append (rest q2) q3) :test #'eq))) (go strt)) )) (let ((l)) (labels ((loop (r c) (push (list r c) l) (cond ((and (zerop r) (zerop c))) (t (let ((nx (third (aref b r c)))) (loop (first nx) (second nx))))))) (loop 39 78)) (format t "Steps = ~s~%Path = [" (length l)) (dolist (x (mapcar #'(lambda (cr) (list (1+ (first cr)) (1+ (second cr)))) l)) (format t "[~s ~s] " (first x) (second x))) (princ #\]) (values) )
Useless Use Of ...
Wow, that is some ugly code. If I've ever seen a program that needed 10 or 15 minutes of cleanup, it's that one.
A few minutes after the contest, Jim pointed out (correctly) that the use of "sort" is useless. It would be useful if, for example, we wanted the distance of a diagonal step to count as √2 times the distance of a vertical or horizontal step.
Speaking of a Useless Use of Sort... is everyone here familiar with UUOC? If not, it's worth a google.
A pure functional version
I decided to try writing a pure functional version, with no data structures except lists-- classic "classroom style" Lisp programming. Although I originally thought that using a 2D array would be the easiest way to solve this problem, now I think that using lists is just as easy, or possibly easier.
It uses
mapcar
to fan-out the search, andremove-duplicates
to limit the combinatorial explosion, andset-difference
to avoid searching backward, or through walls, or outside the maze.Actually the duplicate removal and the backward search prevention could be skipped, and technically the program would still be correct-- but the speed would be horrible. Currently the speed is acceptable. I wonder how it would be with Scott Burson's functional collections.
Almost everything is done in parallel. The code in the loop runs only 12 times, when solving the 7x9 maze. Of course there's a ton of inner looping, implicit in the primitives... when it's running on an x86. But instead of compiling to x86 instructions, imagine compiling to an FPGA configuration, with enough gates to handle each maze cell separately. The execution would grow through the maze in parallel, just like a wildfire grows on every flame-front in parallel.
The code below has two hacks. (1) It searches from lower right to upper left. This way it can handle varying maze size, with no code. (2) It uses a custom test for set member equality (with
:key #'first
). This way trails will be considered duplicates of each other, if they lead from the same place to the exit, even if they take different routes to get there.Use
(trace solve-loop)
and(solve-maze "sample7x9.txt")
to watch it work.(edited 2009-05-20: s/x386/x86/)
Eric Lavigne's solution and path checker in Clojure
A python solution from Jim and Marly Wilson
Rat maze animation
This is a GIF animation that shows the maze being solved. The colors were chosen to suggest a wildfire spreading through a forest.
The last frame is a solution of the maze (in fact, it includes every solution) because each burned cell has little arrowheads pointing back to the cells that ignited it.
The rat only needs to follow arrowheads, and he's guaranteed to get out after visiting the least possible number of cells.
(Hmm... I don't see a way to upload the GIF files. I'll send 'em to Clint.)