## Sunday, September 13, 2009

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