(defconstant cube-limits
(let ((table (make-hash-table)))
(setf (gethash 'red table) 12)
(setf (gethash 'green table) 13)
(setf (gethash 'blue table) 14)
table))
(defun check-limit (draw)
(block s
(loop for colour being each hash-key in draw using (hash-value count)
do (let ((limit (gethash colour cube-limits)))
(if (> count (or limit 0))
(return-from s nil))))
T))
(defstruct tokenizer
(source nil :type string)
(position 0 :type integer))
(defmacro check-ranges (qe &rest bounds)
(let ((qry (gensym)) (last-bound nil) (in-range nil) (node-stack nil))
(dolist (bound bounds)
(if (and node-stack in-range (eq bound last-bound)
(not (eq nil last-bound)))
(progn
(setf in-range nil)
(setf (car node-stack) `(if (= ,qry ,bound) t nil)))
(let ((new-node
(if in-range
`(if (<= ,qry ,bound)
t
nil)
`(if (< ,qry ,bound)
nil
t))))
(setf last-bound bound)
(push new-node node-stack)
(setf in-range (not in-range)))))
(let ((node nil))
(loop for new-node = (pop node-stack)
while new-node
do (setf node
(if node
(append
(subseq new-node 0 3)
(list node)
(subseq new-node 4))
new-node)))
`(let ((,qry ,qe))
,node))))
(defun is-space (the-char)
(check-ranges (char-code the-char) 9 13 32 32 160 160 5760 5760 8192 8202
8239 8239 8287 8287 12288 12288))
(defun skip-whitespace (toks)
(loop while (and
(< (tokenizer-position toks) (length (tokenizer-source toks)))
(is-space
(aref (tokenizer-source toks) (tokenizer-position toks))))
do (incf (tokenizer-position toks))))
(defun next-token (toks)
(skip-whitespace toks)
(when (< (tokenizer-position toks) (length (tokenizer-source toks)))
(let*
((ix (tokenizer-position toks))
(alf (alphanumericp (aref (tokenizer-source toks) ix))))
(loop
while (and (< ix (length (tokenizer-source toks)))
(let ((cc (aref (tokenizer-source toks) ix)))
(and
(not (is-space cc))
(eq alf (alphanumericp cc)))))
do (incf ix))
(prog1
(subseq (tokenizer-source toks) (tokenizer-position toks) ix)
(setf (tokenizer-position toks) ix)))))
(defun parse-line (line)
(let ((toks (make-tokenizer :source line))
(game-number nil)
(grab (make-hash-table)))
(unless (equalp "Game" (next-token toks))
(warn "Input line doesn't begin with \"Start\""))
(setf game-number (parse-integer (next-token toks)))
(unless (equalp ":" (next-token toks)) (warn "Missing colon"))
(loop for
count = (let ((tok (next-token toks)))
(if tok
(parse-integer tok)))
for colour = (intern (string-upcase (next-token toks)))
for delim = (next-token toks)
while (and count colour)
do (setf (gethash colour grab) (max (or (gethash colour grab) 0) count))
(unless (or (equalp delim ";") (equalp delim ",") (not delim))
(warn (format nil "Unrecognized delimiter: ~a" delim))))
(cons game-number grab)))
(defun all (predicate values)
(dolist (value values)
(unless (funcall predicate value)
(return-from all nil)))
t)
(defun power-product (bag)
(let ((p 1))
(loop for v being each hash-value in bag
do (setf p (* p v)))
p))
(defun process-file (instream)
(let ((part1 0)
(part2 0))
(loop for line = (read-line instream nil)
while line
do (let ((game (parse-line line)))
(setf part1 (+ part1 (if (check-limit (cdr game))
(car game)
0)))
(setf part2 (+ part2 (power-product (cdr game))))))
(format t "Part 1: ~a~%" part1)
(format t "Part 2: ~a~%" part2)))
(defun main ()
(loop for arg in (cdr *posix-argv*)
do (with-open-file (s arg :direction :input)
(process-file s))))