Skip navigation.
Home
Freedom is contagious.

Robert Munyer is "Fastest Codeslinger of 2009"

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

Comment viewing options

Select your preferred way to display the comments and click "Save settings" to activate your changes.

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, and remove-duplicates to limit the combinatorial explosion, and set-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.

(defun transform-input (filename)
  ; returned list starts with lower-right dot; order of others doesn't matter.
  (with-open-file (in filename)
    (labels ((read-loop (row col out)
               (case (read-char in nil :eof) ; the only non-functional line
                 (:eof out)
                 (#\newline (read-loop (1+ row) 1 out))
                 (#\. (read-loop row (1+ col) `(((,row ,col)) ,@out)))
                 (otherwise (read-loop row (1+ col) out)))))
      (read-loop 1 1 nil))))

(defun transform-output (trail)
  (format nil "Steps = ~d~%Path = [~{[~{~d~^ ~}]~^ ~}]" (length trail) trail))

(defun solve-loop (this-batch available)
  (or (find '(1 1) this-batch :test #'equal :key #'first) ; if not null: solved!
      (flet ((difference (minuend subtrahend)
               (set-difference minuend subtrahend :test #'equal :key #'first)))
        (let* ((lists-of-neighbors
                 (mapcar #'(lambda (trail)
                             (mapcar #'(lambda (offset)
                                         (cons (mapcar #'+ offset (first trail))
                                               ; this builds the solution trail
                                               trail))
                                     '((-1 -1) (-1 0) (-1 +1)
                                       ( 0 -1)        ( 0 +1)
                                       (+1 -1) (+1 0) (+1 +1))))
                         this-batch))
               (set-of-neighbors
                 (remove-duplicates (reduce #'append lists-of-neighbors)
                                    :test #'equal :key #'first))
               (unavailable ; out of bounds, or a wall, or already visited
                 (difference set-of-neighbors available))
               (next-batch (difference set-of-neighbors unavailable)))
          (and next-batch ; if null: can't be solved!
               (solve-loop next-batch (difference available next-batch)))))))

(defun solve-maze (filename)
  (let ((input (transform-input filename)))
    (transform-output (solve-loop (list (first input)) (rest input)))))

(edited 2009-05-20: s/x386/x86/)

clintc's picture

Eric Lavigne's solution and path checker in Clojure

(ns maze
	(:use clojure.set))

(def simple-board-string
".###..###
..###..##
..####.##
.#####.#.
..####.#.
#......#.
#.#####..")

(def panic-drafta-board-string
"..........................................#....................................
########...#######..##....##.####.#########...#############....................
##.....##.##.....##.###...##.####....##..............###.......................
##.....##.##.....##.####..##..##.....##................########................
##.....##.##.....##.##.##.##.##......##..........#####....#....................
##.....##.##.....##.##..####.........##.....####..........#....................
##.....##.##.....##.##...###.........##........###############################.
########...#######..##....##.........##............#...........................
...................................................#..........#######..........
.........###########################################...........................
.....................................................##########################
####################################################...........................
.....................................................##########################
########.....###....##....##.####..######.....####.############################
##.....##...##.##...###...##..##..##....##....####.............................
##.....##..##...##..####..##..##..##..........####.............................
########..##.....##.##.##.##..##..##...........##..............................
##........#########.##..####..##..##...........................................
##........##.....##.##...###..##..##....##....####.............................
##........##.....##.##....##.####..######.....####.............................
.........................#........................#############################
........#########################################.......#######################
...............................................................................
.#############################################################################.
..###########################################################################..
...########################################################################..##
....######################################################################..###
.....####################################################################..####
......##################################################################.......
.......################################################################....####
........##############################################################...######
.........############################################################...#######
.###################################################################...........
...............................................................................
.##############################################################################
...............................................................................
##############################################################################.
...............................................................................
.##############################################################################
...............................................................................")

(defn cartesian-product [seq1 seq2]
	(mapcat 
		(fn [x1] 
			(map 
				(fn [x2] (list x1 x2)) 
				seq2))
		seq1))

; make board from string where obstacles are '#' and empty spaces are '.'
; board is set of allowed positions as [x y]
(defn board-and-goal-from-string [s]
	(let 
		[rows (filter not-empty (map (fn [s] (.trim s)) (.split s "\n")))
		 num-rows (count rows)
		 num-cols (count (first rows))]
		[(set
			(filter
				(fn [pos] 
					(= \. 
						(nth
							(nth rows (- (first pos) 1))
							(- (second pos) 1))))
				(cartesian-product 
					(range 1 (+ 1 num-rows)) 
					(range 1 (+ 1 num-cols)))))
		 [num-rows num-cols]]))

(defn board-from-string [s]
	(get (board-and-goal-from-string s) 0))
	
(defn goal-from-string [s]
	(get (board-and-goal-from-string s) 1))

(def simple-board (board-from-string simple-board-string))

(def simple-goal (goal-from-string simple-board-string))

(def panic-drafta-board (board-from-string panic-drafta-board-string))

(def panic-drafta-goal (goal-from-string panic-drafta-board-string))

(defn maze-step [start]
	(map 
		(fn [direction] (map + start direction))
		(cartesian-product [-1 0 1] [-1 0 1])))

(defn maze-search 
	([old-paths allowed-states goal-state]
		(when (not (empty? old-paths))
			(let [next-path (first old-paths)
			      next-state (first next-path)
			      new-states (filter (fn [s] (contains? allowed-states s)) (maze-step next-state))]
				(if (= goal-state next-state)
					(reverse next-path)
					(recur
						(concat
							(rest old-paths)
							(map (fn [s] (cons s next-path)) new-states))
						(difference allowed-states (set new-states))
						goal-state)))))
	([allowed-states goal-state]
		(maze-search [[[1 1]]] allowed-states goal-state)))

(def simple-result 
	(maze-search 
		simple-board 
		simple-goal))
		
(def panic-drafta-result 
	(maze-search 
		panic-drafta-board 
		panic-drafta-goal))

(defn mis-step? [path board goal]
	(cond 
		(empty? path)	nil
		(not (contains? board (first path))) (first path)
		:default (recur (rest path) board goal)))

(defn contains-start? [path board goal]
	(= [1 1] (first path)))

(defn contains-goal? [path board goal]
	(contains? (set path) goal))

(defn long-step? [path board goal]
	(when (and (first path) (second path))
		(if (contains? (set (maze-step (first path))) (second path))
			(recur (rest path) board goal)
			[(first path) (second path)])))

(defn solution-mistake [path board goal]
	(cond
		(not (contains-start? path board goal)) {:include-start [1 1]}
		(not (contains-goal? path board goal)) {:include-goal goal}
		(mis-step? path board goal) {:mis-step (mis-step? path board goal)}
		(long-step? path board goal) {:long-step (long-step? path board goal)}
		(> (count path) (count (maze-search board goal))) {:solution-too-long (count path)}))

(def simple-result-skip-start
	'((2 1) (3 1) (4 1) (5 2) (6 3) (6 4) (6 5) (6 6) (6 7) (7 8) (7 9)))

(def simple-result-skip-goal
	'([1 1] (2 1) (3 1) (4 1) (5 2) (6 3) (6 4) (6 5) (6 6) (6 7) (7 8)    ))

(def simple-result-mis-step
	'([1 1] (2 1) (3 1)   (4 2)   (5 2) (6 3) (6 4) (6 5) (6 6) (6 7) (7 8) (7 9)))

(def simple-result-skip-mid
	'([1 1] (2 1) (3 1) (4 1)     (6 3) (6 4) (6 5) (6 6) (6 7) (7 8) (7 9)))

(def simple-result-inefficient
	'([1 1] (2 1) (3 1) (4 1) (5 1) (6 2) (6 3) (6 4) (6 5) (6 6) (6 7) (7 8) (7 9)))
clintc's picture

A python solution from Jim and Marly Wilson

#!/usr/bin/env python

###  Parse input into sideways 2-dim list. I.e., Element x,y is at maze[y][x]
#
#  E.g., "..#\n#.#\n" will become [ ['.', '.', '#'], ['#', '.', '#'] ]
#
# BUGS: The maze must be well formed. The Y coordinate increases downward

from sys import argv
maze = [list(l.strip()) for l in open(argv[1])]	# Parsing was the easy part.

W = len(maze[0])	# Width of maze (characters in first row)
H = len(maze)		# Height of maze (number of rows)

def valid(x,y):		# Check coordinate within maze rectangle
  return (
    0 <= x < W and
    0 <= y < H)

def moves(x,y): return (# Returns octuple of coordinates one move from (x,y).
  (x+0,y+1), (x+0,y-1),	#   NOTE:  Some may be outside rectangular maze.
  (x+1,y-1), (x+1,y+0),	#          Others may be blocked by '#'.
  (x+1,y+1), (x-1,y-1),
  (x-1,y+0), (x-1,y+1))
  
def move(X,Y):		# Add neighbors of X,Y to queue and mark with cost.
  global queue		# Queue is global fifo of points
  c = maze[Y][X]+1	# It costs one step to move from here to there

  for x,y in moves(X,Y):	# Loop through neighbors of (X,Y):
    if (valid(x,y) and 		#   If not outsize maze and
    maze[y][x] == '.'):		#   haven't already been there,
      queue.append((x,y))	#     put neighbor onto end of queue
      maze[y][x] = c		#     change cost from '.' to number of steps.


# First loop floods maze and labels each point with the cost (number of 
# moves) for the rat to reach it.

queue = [(0,0)]		# Rat starts in upper-left corner
maze[0][0] = 0 		# Flood maze and replace each reachable '.' with the
while queue:		# 'cost' to reach it from upper left corner.
  x,y = queue.pop(0)	# Remove lowest-cost point from *head* of queue
  move(x,y)		#   visit, add neighbors to *tail* of queue
  
# We got the above code written when Robert announced his program had found
# the solution. We got the above code *debugged* by the time Eric verified
# our hopes were dashed and Robert had won.
#
# By the time I got home, Marly had broken up move(X,Y) into three separate
# functions (as you see it now) to make two of them useful for the following
# function, and was just finishing the second loop that actually accumulates
# the *backward* path into a list.
#
# I did some housekeeping and added comments and code to handle the case when 
# no path exists.

def retrace(X,Y):	# Return a neighbor of X,Y one step closer to start
  c = maze[Y][X]-1	# Cost of neighbor that's one step closer
  for x,y in moves(X,Y):# Loop through neighbors of (X,Y)
    if (valid(x,y) and 	#   If inside maze and
    maze[y][x] == c): 	#   exactly one step closer to start,
      return x,y	#     return another step backward

# Second loop starts at the endpoint and marches back toward the start.

x,y = W-1, H-1  		# The rat's endpoint, the lower-right corner
if type(maze[y][x]) != int:	# Defends against no-solution case	
  quit("no solution")
  
# We started at (0,0), but in ratspeak, that's (1,1).  The solution demands
# ratspeak, so we'll just add 1,1 to each solution point.
  
steps = [(x+1,y+1)]		# First step back is last step out
while x or y:			# Until back at (0,0):
  x,y = retrace(x,y)		#   Take a step back
  steps.append((x+1,y+1))	#   Add new location to list

steps.reverse()			# Change backward path to forward
print len(steps),"points:",	# Print number, list of points rat visits
print steps		

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

Comment viewing options

Select your preferred way to display the comments and click "Save settings" to activate your changes.