Wednesday, May 28, 2008

Google Treasure Hunt 2008: Puzzle 1 (robot) solution

Google Treasure Hunt is a sequence of (four?) nice puzzles, three of which have been published so far. Since everybody blogs how they solved them, here are my solutions (so far).

;;; "Robot" puzzle
;;; Author: Simon Leinen
;;; Date created: 18-May-2008
;;; There's an NxM (N cases wide and M cases high) grid with the robot
;;; in the upper left corner and a treasure in the lower right. The
;;; robot can only go RIGHT or DOWN. How many possible distinct paths
;;; are there for the robot to reach the treasure?
;;; Solution:
;;; If the grid is 1xM or Nx1, there is only one possibility. This is
;;; our stop condition: Npaths(1,M) = 1, Npaths(N,1) = 1.
;;; Otherwise, M>1 and N>1. So the robot can go right and take one of
;;; Npaths(N-1,M) paths to the destination, or go down and take one of
;;; Npaths(N,M-1) paths.
;;; It is trivial to write a recursive function according to this
;;; definition, but the function will be very inefficient, because it
;;; generates an exponential explosion of recursive calls - most
;;; invocations will generate two new invocations -> chain reaction.
;;; This is the same as a certain definition of the Fibonacci series
;;; (which I personally don't find that natural), and a standard way
;;; to solve this is through "memoization", i.e. remembering the
;;; results for all calls that have terminated. There are many
;;; standard libraries for this, but I don't know where to find one
;;; and how to use it, so I'll roll my own.
;;; Thankfully, Lisp has "bignums", so we don't have to worry too much
;;; about how large the result may get.
;;; I could have improved efficiency somewhat by ordering width and
;;; height, but the code is Good Enough as is.

(in-package :cl-user)

(defvar +memo-npaths+
(make-hash-table :test #'equal))

(defmacro with-memoization ((&rest arglist) memo-form form)
(let ((result-var (gensym "result"))
(memo-var (gensym "memo")))
`(let* ((,memo-var ,memo-form)
(,result-var (gethash (list ,@arglist) ,memo-var)))
(or ,result-var
(setf (gethash (list ,@arglist) ,memo-var)

(defun npaths (width height)
(with-memoization (width height)
(npaths-internal width height)))

(defun npaths-internal (width height)
(if (or (zerop width) (zerop height))
(+ (npaths (1- width) height)
(npaths width (1- height)))))
Post a Comment