Google Code Jam 2009 - solutions in Common Lisp

Last year I had a lot of fun with the small puzzles of Google Treasure Hunt.  This year, there was no treasure hunt, so I decided to participate in Google Code Jam.  Code Jam seems to be quite a bit more competitive, with multiple rounds where only the top N scorers pass.  So far, I have passed the qualification round and the first online round.  I will almost certainly fail to pass the next round, because there will be only 250 participants to advance (and receive a T-shirt).  My natural rank seems to be in the high triple digits or low quadruple digits.  But maybe there will be a miracle!

Someone wrote a kind of mashup that walks the Google Code Jam submission/score database, and which allows queries e.g. per programming language.  Here's the statistics for Lisp:
http://www.go-hero.net/jam/09/lang/Lisp

I registered as "insertsomethingwitty" (I have never been good with pseudonyms), and you can find my submissions here: http://www.go-hero.net/jam/09/name/insertsomethingwitty

Bribe the Prisoners

In the two rounds I participated in ("Qualifier" and 1C), I managed to submit correct solutions for all problem sets except for the very last one, namely the "large input" for "Bribe the prisoners".  I took a bad approach to that one, and was lucky to even finish the small input set before the end of the round (2h30 for three problems).

After a nice walk, I found a simpler approach.  I had to apply memoization to make it efficient, and then I was able to run the large input set in about two minutes on my netbook - the limit is eight minutes.  Here is the new code.

(defun solve (file &optional (dest t))
  (with-open-file (s file)
    (let ((nsamples (parse-integer (read-line s))))
      (dotimes (k nsamples)
 (solve-case k s dest)))))

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

(defun solve-case (caseno s dest)
  (clrhash *memo*)
  (let ((line (mapcar #'parse-integer (split-at-spaces (read-line s)))))
    (multiple-value-bind (p q)
 (values (first line) (second line))
      (let ((rel (mapcar #'parse-integer (split-at-spaces (read-line s)))))
 (assert (= (length rel) q))
 (format dest "Case #~D: ~D~%" (1+ caseno) (minbribe p rel))))))

(defun minbribe (p rel &aux entry)
  (cond ((endp rel) 0)
 ((endp (rest rel)) (1- p))
 ((setq entry (gethash (cons p rel) *memo*)) entry)
 (t (setf (gethash (cons p rel) *memo*)
      (reduce #'min (mapcar
       #'(lambda (prisoner)
    (minbribe-1 prisoner p rel))
       rel))))))

(defun minbribe-1 (prisoner p rel)
  (cond ((<= p 1) 0)
 (t (+ (- p 1)
       (multiple-value-bind (p1 rel1 p2 rel2)
    (split-cells prisoner p rel)
  (+ (minbribe p1 rel1)
     (minbribe p2 rel2)))))))

(defun split-cells (prisoner p rel)
  (do ((rel rel (rest rel))
       (seq1 '() (cons (first rel) seq1)))
      ((= (first rel) prisoner)
       (do ((rel (rest rel) (rest rel))
     (seq2 '() (cons (- (first rel) prisoner) seq2)))
    ((endp rel)
     (values (1- prisoner) (nreverse seq1) (- p prisoner) (nreverse seq2)))))))