# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1512344385 18000
# Node ID 11607ca439c40825a59dfd7c814bb3fe19f422b0
# Parent  5e8fb9b8a5530da0bb68d9acbb57b1b2f340f091
Day 3

diff -r 5e8fb9b8a553 -r 11607ca439c4 advent.asd
--- a/advent.asd	Sat Dec 02 12:49:22 2017 -0500
+++ b/advent.asd	Sun Dec 03 18:39:45 2017 -0500
@@ -13,4 +13,5 @@
                              (:file "quickutils")))
                (:file "package")
                (:module "src" :serial t
-                :components ((:file "main")))))
+                :components ((:file "number-spiral")
+                             (:file "main")))))
diff -r 5e8fb9b8a553 -r 11607ca439c4 package.lisp
--- a/package.lisp	Sat Dec 02 12:49:22 2017 -0500
+++ b/package.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -1,2 +1,6 @@
 (defpackage :advent
   (:use :cl :losh :iterate :advent.quickutils))
+
+(defpackage :advent.spiral
+  (:use :cl :losh :iterate :advent.quickutils)
+  (:export :number-coordinates))
diff -r 5e8fb9b8a553 -r 11607ca439c4 scratch.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -0,0 +1,113 @@
+    ;;;; Spirals -------------------------------------------------------------------
+    (defun layer-side-length (layer)
+      "Return the length of one side of `layer`."
+      (1+ (* 2 layer)))
+    
+    (defun layer-size (layer)
+      "Return the total size of a number spiral with a final layer of `layer`."
+      (square (layer-side-length layer)))
+    
+    (defun layer-for-number (number)
+      "Return the index of the layer containing `number`."
+      (ceiling (/ (1- (sqrt number)) 2)))
+    
+    (defun layer-start (layer)
+      "Return the smallest number in `layer`."
+      (if (zerop layer)
+        1
+        (1+ (layer-size (1- layer)))))
+    
+    (defun layer-leg-length (layer)
+      "Return the length of one \"leg\" of `layer`."
+      (1- (layer-side-length layer)))
+    
+    
+    (defun leg (layer number)
+      "Return the leg index and offset of `number` in `layer`."
+      (if (= 1 number)
+        (values 0 0)
+        (let ((idx (- number (layer-start layer)))
+              (legsize (layer-leg-length layer)))
+          (values (floor idx legsize)
+                  (1+ (mod idx legsize))))))
+    
+    (defun corner-coordinates (layer leg)
+      "Return the coordinates of the corner starting `leg` in `layer`.
+    
+      Leg | Corner
+       0  | Bottom Right
+       1  | Top Right
+       2  | Top Left
+       3  | Bottom Left
+    
+      "
+    
+      ;; 2   1
+      ;;
+      ;; 3   0
+      (ccase leg
+        (0 (complex layer (- layer)))
+        (1 (complex layer layer))
+        (2 (complex (- layer) layer))
+        (3 (complex (- layer) (- layer)))))
+    
+    (defun leg-direction (leg)
+      "Return the direction vector for the given `leg`.
+      "
+      ;;    <--
+      ;;   11110
+      ;; | 2   0 ^
+      ;; | 2   0 |
+      ;; v 2   0 |
+      ;;   23333
+      ;;    -->
+      (ccase leg
+        (0 (complex 0 1))
+        (1 (complex -1 0))
+        (2 (complex 0 -1))
+        (3 (complex 1 0))))
+    
+    
+    (defun number-coordinates (number)
+      (nest
+        ;; Find the layer the number falls in.
+        (let ((layer (layer-for-number number))))
+    
+        ;; Find which leg of that layer it's in, and how far along the leg it is.
+        (multiple-value-bind (leg offset) (leg layer number))
+    
+        ;; Find the coordinates of the leg's corner, and its direction vector.
+        (let ((corner (corner-coordinates layer leg))
+              (direction (leg-direction leg))))
+    
+        ;; Start at the corner and add the offset in the leg's direction to find the
+        ;; number's coordinates.
+        (+ corner (* direction offset))))
+    
+    
+    ;;;; Main ---------------------------------------------------------------------
+    (defun day-3-part-1 ()
+      (labels ((manhattan-distance (a b)
+                 (+ (abs (- (realpart a)
+                            (realpart b)))
+                    (abs (- (imagpart a)
+                            (imagpart b)))))
+               (distance-to-origin (p)
+                 (manhattan-distance #c(0 0) p)))
+        (distance-to-origin (number-coordinates 325489))))
+    
+    (defun day-3-part-2 ()
+      (flet ((neighbors (coord)
+               (iterate (for-nested ((dx :from -1 :to 1)
+                                     (dy :from -1 :to 1)))
+                        (unless (= 0 dx dy)
+                          (collect (+ coord (complex dx dy)))))))
+        (iterate
+          (with memory = (make-hash-table))
+          (initially (setf (gethash #c(0 0) memory) 1))
+          (for n :from 2)
+          (for coord = (number-coordinates n))
+          (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
+          (finding value :such-that (> value 325489))
+          (setf (gethash coord memory) value))))
+    
diff -r 5e8fb9b8a553 -r 11607ca439c4 src/2015.lisp
--- a/src/2015.lisp	Sat Dec 02 12:49:22 2017 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,898 +0,0 @@
-; https://bitbucket.org/sjl/beef
-(ql:quickload "beef")
-(ql:quickload "alexandria")
-(ql:quickload "split-sequence")
-(ql:quickload "cl-arrows")
-(ql:quickload "fset")
-(ql:quickload "cl-ppcre")
-(ql:quickload "ironclad")
-(ql:quickload "smug")
-(ql:quickload "bit-smasher")
-(ql:quickload "optima")
-
-(defpackage #:advent
-  (:use #:cl)
-  (:use #:cl-arrows)
-  (:use #:split-sequence)
-  (:use #:smug))
-
-(in-package #:advent)
-
-(declaim (optimize (debug 3)))
-
-;;;; Day 1
-(defun instruction-to-num (ch)
-  (cond
-    ((eql ch #\() 1)
-    ((eql ch #\)) -1)
-    (t 0)))
-
-(defun advent-1-1 ()
-  (loop :for c :across (beef:slurp "data/1")
-        :sum (instruction-to-num c)))
-
-(defun advent-1-2 ()
-  (loop :for c :across (beef:slurp "data/1")
-        :sum (instruction-to-num c) :into floor
-        :sum 1
-        :until (= floor -1)))
-
-
-;;;; Day 2
-(defun advent-2-data ()
-  (->> (beef:slurp "data/2")
-       beef:trim-whitespace-right
-       beef:split-lines
-       (mapcar (lambda (s)
-                 (->> s
-                      (split-sequence #\x)
-                      (mapcar #'parse-integer))))))
-
-(defun advent-2-1 ()
-  (loop :for dims :in (advent-2-data)
-        :for (w h l) = dims
-        :for sides = (list (* w h)
-                           (* w l)
-                           (* h l))
-        :for paper = (* 2 (apply #'+ sides))
-        :for slack = (apply #'min sides)
-        :sum (+ paper slack)))
-
-(defun advent-2-2 ()
-  (loop :for dims :in (advent-2-data)
-        :for (w h l) = dims
-        :for sides = (list (* 2 (+ w h))
-                           (* 2 (+ w l))
-                           (* 2 (+ h l)))
-        :for ribbon = (apply #'min sides)
-        :for bow = (apply #'* dims)
-        :sum (+ ribbon bow)))
-
-
-;;;; Day 3
-(defun advent-3-data ()
-  (beef:trim-whitespace (beef:slurp "data/3")))
-
-(defun instruction-to-offsets (instruction)
-  (case instruction
-    (#\> '(1 0))
-    (#\< '(-1 0))
-    (#\^ '(0 1))
-    (#\v '(0 -1))))
-
-(defun step-santa (loc dir)
-  (destructuring-bind (x y) loc
-    (destructuring-bind (dx dy) (instruction-to-offsets dir)
-      (list (+ x dx) (+ y dy)))))
-
-(defun houses (data)
-  (loop
-    :with loc = '(0 0)
-    :with visited = (fset:set '(0 0))
-    :for dir :across data
-    :do (setq loc (step-santa loc dir))
-    :do (fset:includef visited loc)
-    :finally (return visited)))
-
-(defun advent-3-1 (data)
-  (fset:size (houses data)))
-
-(defun advent-3-2 (data)
-  (fset:size
-    (fset:union
-      ;                                 come directly at me
-      (houses (ppcre:regex-replace-all "(.)." data "\\1"))
-      (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
-
-
-;;;; Day 4
-(defun advent-4-data ()
-  "ckczppom")
-
-(defun md5 (str)
-  (ironclad:byte-array-to-hex-string
-    (ironclad:digest-sequence :md5
-                              (ironclad:ascii-string-to-byte-array str))))
-
-(defun mine (data zeroes)
-  (let ((target (apply #'concatenate 'string
-                       (loop :repeat zeroes :collect "0"))))
-    (loop :for i :upfrom 1
-          :for hash = (->> i
-                           prin1-to-string
-                           (concatenate 'string data)
-                           md5)
-          :until (equal target (subseq hash 0 zeroes))
-          :finally (return i))))
-
-(defun advent-4-1 (data)
-  (mine data 5))
-
-(defun advent-4-2 (data)
-  (mine data 6))
-
-
-;;;; Day 5
-(defun advent-5-data ()
-  (-> "data/5"
-      beef:slurp
-      beef:trim-whitespace-right
-      beef:split-lines))
-
-(defun join-strings (strings delim)
-  "Join strings into a single string with the given delimiter string interleaved.
-
-   Delim must not contain a ~.
-
-   "
-  (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
-
-
-(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
-
-(defun count-vowels (s)
-  (length (ppcre:regex-replace-all "[^aeiou]" s "")))
-
-(defun has-run (s)
-  (when (ppcre:scan "(.)\\1" s) t))
-
-(defun has-bad (s)
-  (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
-
-(defun is-nice (s)
-  (and (>= (count-vowels s) 3)
-       (has-run s)
-       (not (has-bad s))))
-
-(defun advent-5-1 (data)
-  (count-if #'is-nice data))
-
-(defun has-run-2 (s)
-  (when (ppcre:scan "(..).*\\1" s) t))
-
-(defun has-repeat (s)
-  (when (ppcre:scan "(.).\\1" s) t))
-
-(defun is-nice-2 (s)
-  (and (has-run-2 s)
-       (has-repeat s)))
-
-(defun advent-5-2 (data)
-  (count-if #'is-nice-2 data))
-
-
-;;;; Day 6
-(defun advent-6-data ()
-  (beef:slurp-lines "data/6" :ignore-trailing-newline t))
-
-(defmacro loop-array (arr name &rest body)
-  (let ((i (gensym "index")))
-    `(loop :for ,i :below (array-total-size ,arr)
-           :for ,name = (row-major-aref ,arr ,i)
-           ,@body)))
-
-(defun parse-indexes (s)
-  (->> s
-       (split-sequence #\,)
-       (mapcar #'parse-integer)))
-
-(defun flip (b)
-  (if (zerop b) 1 0))
-
-(defun parse-line (line)
-  (let ((parts (split-sequence #\space line)))
-    (list (parse-indexes (beef:index parts -3))
-          (parse-indexes (beef:index parts -1))
-          (cond
-            ((equal (car parts) "toggle") :toggle)
-            ((equal (cadr parts) "on") :on)
-            ((equal (cadr parts) "off") :off)
-            (t (error "Unknown operation!"))))))
-
-(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
-  `(loop :for ,r :from ,from-row :to ,to-row
-         :do (loop :for ,c :from ,from-col :to ,to-col
-                   ,@body)))
-
-(defun advent-6-1 (data)
-  (let ((lights (make-array '(1000 1000) :element-type 'bit)))
-    (loop
-      :for line :in data
-      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
-      :do (loop-square
-            r c from-row from-col to-row to-col
-            :do (setf (bit lights r c)
-                      (case operation
-                        (:toggle (flip (bit lights r c)))
-                        (:on 1)
-                        (:off 0)
-                        (t 0)))))
-    (loop-array lights b
-                :sum b)))
-
-(defun advent-6-2 (data)
-  (let ((lights (make-array '(1000 1000) :element-type 'integer)))
-    (loop
-      :for line :in data
-      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
-      :do (loop-square
-            r c from-row from-col to-row to-col
-            :do (case operation
-                  (:toggle (incf (aref lights r c) 2))
-                  (:on (incf (aref lights r c)))
-                  (:off (when (not (zerop (aref lights r c)))
-                          (decf (aref lights r c)))))))
-    (loop-array lights b
-                :sum b)))
-
-
-;;;; Day 7
-(defun advent-7-data ()
-  (beef:slurp-lines "data/7" :ignore-trailing-newline t))
-
-(defun advent-7-2-data ()
-  (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
-
-(defun int->bits (i)
-  (bitsmash:bits<- (format nil "~4,'0X" i)))
-
-(defun bit-lshift (bit-array distance)
-  (replace (make-array (length bit-array) :element-type 'bit)
-           bit-array
-           :start1 0
-           :start2 (bitsmash:int<- distance)))
-
-(defun bit-rshift (bit-array distance)
-  (let ((width (length bit-array))
-        (distance (bitsmash:int<- distance)))
-    (replace (make-array width :element-type 'bit)
-             bit-array
-             :start1 distance
-             :end2 (- width distance))))
-
-(defun .zero-or-more (parser)
-  (.plus (.let* ((x parser)
-                 (xs (.zero-or-more parser)))
-           (.identity (cons x xs)))
-         (.identity ())))
-
-(defun .one-or-more (parser)
-  (.let* ((x parser)
-          (y (.zero-or-more parser)))
-    (.identity (cons x y))))
-
-(defun parse-7 (line)
-  (labels ((.whitespace ()
-             (.first (.one-or-more (.is 'member '(#\space #\tab)))))
-           (.arrow ()
-             (.first (.string= "->")))
-           (.number ()
-             (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
-                    (.identity (parse-integer (concatenate 'string digits)))))
-           (.wire ()
-             (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
-                    (.identity (concatenate 'string chars))))
-           (.source ()
-             (.or (.wire) (.number)))
-           (.string-choice (strs)
-             (if (not strs)
-               (.fail)
-               (.or (.string= (car strs))
-                    (.string-choice (cdr strs)))))
-           (.dest ()
-             (.progn (.whitespace) (.arrow) (.whitespace)
-                     (.wire)))
-           (.constant-source ()
-             (.let* ((val (.source)))
-                    (.identity (list #'identity (list val)))))
-           (.binary-op ()
-             (let ((ops '(("AND" . bit-and)
-                          ("OR" . bit-ior)
-                          ("LSHIFT" . bit-lshift)
-                          ("RSHIFT" . bit-rshift))))
-               (.let* ((name (.string-choice (mapcar #'car ops))))
-                      (.identity (cdr (assoc name ops :test #'equal))))))
-           (.binary-source ()
-             (.let* ((left (.source))
-                     (_ (.whitespace))
-                     (op (.binary-op))
-                     (_ (.whitespace))
-                     (right (.source)))
-                    (.identity (list op (list left right)))))
-           (.unary-op ()
-             (.let* ((_ (.string= "NOT")))
-                    (.identity #'bit-not)))
-           (.unary-source ()
-             (.let* ((op (.unary-op))
-                     (_ (.whitespace))
-                     (source (.source)))
-                    (.identity (list op (list source)))))
-           (.instruction ()
-             (.let* ((source (.or (.binary-source)
-                                  (.unary-source)
-                                  (.constant-source)))
-                     (dest (.dest)))
-                    (.identity (concatenate 'list source (list dest))))))
-    (parse (.instruction) line)))
-
-(defun advent-7-1 (data)
-  (let ((circuit (make-hash-table :test #'equal))
-        (commands (mapcar #'parse-7 data)))
-    (labels ((retrieve (source)
-               (cond
-                 ((stringp source) (gethash source circuit))
-                 ((integerp source) (int->bits source))
-                 (t (error "what?"))))
-             (ready (args)
-               (every #'identity args))
-             (perform (fn args dest)
-               (setf (gethash dest circuit)
-                     (apply fn args)))
-             (try-command (command)
-               "If the command is ready to go, run it and return nil.  Otherwise,
-                return the command itself."
-               (destructuring-bind (fn args dest) command
-                 (let ((vals (mapcar #'retrieve args)))
-                   (if (ready vals)
-                     (progn
-                       (perform fn vals dest)
-                       nil)
-                     command)))))
-      (loop :while commands
-            :do (setf commands
-                  (loop :for command :in commands
-                        :when (try-command command)
-                        :collect :it)))
-      (bitsmash:bits->int (gethash "a" circuit)))))
-
-
-;;;; Day 8
-(defun advent-8-data ()
-  (beef:slurp-lines "data/8" :ignore-trailing-newline t))
-
-
-(defconstant +backslash+ #\\ )
-(defconstant +quote+ #\" )
-
-(defun parse-8 (line)
-  (labels ((.hex-digit ()
-             (.or
-               (.is #'digit-char-p)
-               (.is #'member '(#\a #\b #\c #\d #\e #\f))))
-           (.hex-escape ()
-             (.let* ((_ (.char= #\x))
-                     (a (.hex-digit))
-                     (b (.hex-digit)))
-                    (.identity
-                      (->> (format nil "~A~A" a b)
-                           bitsmash:hex->int
-                           code-char))))
-           (.escaped-char ()
-             (.progn
-               (.char= +backslash+)
-               (.or (.char= +backslash+)
-                    (.char= +quote+)
-                    (.hex-escape))))
-           (.normal-char ()
-             (.is-not 'member (list +backslash+ +quote+)))
-           (.string-char ()
-             (.or (.normal-char)
-                  (.escaped-char)))
-           (.full-string ()
-             (.prog2
-               (.char= +quote+)
-               (.first (.zero-or-more (.string-char)))
-               (.char= +quote+))))
-    (parse (.full-string) line)))
-
-(defun .wrap (fn parser)
-  (.let* ((v parser))
-         (.identity (funcall fn v))))
-
-(defun parse-8-2 (line)
-  (labels ((.special-char ()
-             (.let* ((ch (.or (.char= +backslash+)
-                              (.char= +quote+))))
-                    (.identity (list +backslash+ ch))))
-           (.normal-char ()
-             (.wrap #'list
-                    (.is-not 'member (list +backslash+ +quote+))))
-           (.string-char ()
-             (.or (.normal-char)
-                  (.special-char)))
-           (.full-string ()
-             (.let* ((chars (.zero-or-more (.string-char))))
-                    (.identity (apply #'concatenate 'list chars)))))
-    (append (list +quote+)
-            (parse (.full-string) line)
-            (list +quote+))))
-
-(defun advent-8-1 (data)
-  (loop :for line :in data
-        :for chars = (parse-8 line)
-        :sum (- (length line)
-                (length chars))))
-
-(defun advent-8-2 (data)
-  (loop :for line :in data
-        :for chars = (parse-8-2 line)
-        :sum (- (length chars)
-                (length line))))
-
-
-;;;; Day 9
-(defun advent-9-data ()
-  (beef:slurp-lines "data/9" :ignore-trailing-newline t))
-
-; Thanks Norvig
-; http://norvig.com/paip/gps.lisp
-(defun permutations (bag)
-  "Return a list of all the permutations of the input."
-  ;; If the input is nil, there is only one permutation:
-  ;; nil itself
-  (if (null bag)
-      '(())
-      ;; Otherwise, take an element, e, out of the bag.
-      ;; Generate all permutations of the remaining elements,
-      ;; And add e to the front of each of these.
-      ;; Do this for all possible e to generate all permutations.
-      (mapcan #'(lambda (e)
-                  (mapcar #'(lambda (p) (cons e p))
-                          (permutations
-                            (remove e bag :count 1 :test #'eq))))
-              bag)))
-
-(defun advent-9 (data)
-  (let ((distances (make-hash-table :test #'equal)))
-    (loop :for line :in data
-          :for (a to b _ dist) = (split-sequence #\space line)
-          :for distance = (parse-integer dist)
-          :do (progn
-                (setf (gethash (cons a b) distances) distance)
-                (setf (gethash (cons b a) distances) distance)))
-    (labels ((score-route (route)
-               (optima:match route
-                 ((list _) 0)
-                 ((list* a b _) (+ (gethash (cons a b) distances)
-                                   (score-route (cdr route))))))
-             (dedupe (l)
-               (remove-duplicates l :test #'equal)))
-      (loop :for route :in (->> distances
-                             beef:hash-keys
-                             (mapcar #'car)
-                             dedupe
-                             permutations)
-            :for score = (score-route route)
-            :minimizing score :into min-dist
-            :maximizing score :into max-dist
-            :finally (return (cons min-dist max-dist))))))
-
-
-(defmethod print-object ((object hash-table) stream)
-  (format stream "#HASH{~%~{~{    (~s : ~s)~}~%~}}"
-          (loop for key being the hash-keys of object
-                using (hash-value value)
-                collect (list key value))))
-
-
-;;;; Day 10
-(defun advent-10-data ()
-  "1321131112")
-
-(defun look-and-say (seq)
-  (let ((runs (list))
-        (len 1)
-        (current -1))
-    (flet ((mark-run ()
-             (setf runs (cons current (cons len runs)))))
-    (loop :for n :in seq
-          :do (if (= current n)
-                (incf len)
-                (progn
-                  (when (not (= -1 current))
-                    (mark-run))
-                  (setf len 1)
-                  (setf current n)))
-          :finally (mark-run))
-    (reverse runs))))
-
-(defun iterate (n f data)
-  (declare (optimize speed (debug 0)))
-  (dotimes (_ n)
-    (setf data (funcall f data)))
-  data)
-
-(defun las-to-list (s)
-  (loop :for digit :across s
-        :collect (-> digit string parse-integer)))
-
-(defun advent-10-1 (data)
-  (length (iterate 40 #'look-and-say (las-to-list data))))
-
-(defun advent-10-2 (data)
-  (length (iterate 50 #'look-and-say (las-to-list data))))
-
-
-;;;; Day 11
-(defun advent-11-data ()
-  "vzbxkghb")
-
-
-(defparameter base 26)
-(defparameter ascii-alpha-start (char-code #\a))
-(defun num-to-char (n)
-  (code-char (+ n ascii-alpha-start)))
-
-(defun char-to-num (ch)
-  (- (char-code ch) ascii-alpha-start))
-
-
-(defmacro loop-window (seq width binding-form &rest body)
-  (let ((i (gensym "IGNORE"))
-        (s (gensym "SEQ"))
-        (n (gensym "WIDTH"))
-        (tail (gensym "TAIL")))
-    `(let ((,s ,seq)
-           (,n ,width))
-       (loop :for ,i :upto (- (length ,s) ,n)
-             :for ,tail :on ,s
-             :for ,binding-form = (subseq ,tail 0 ,n)
-             ,@body))))
-
-
-(defun is-straight-3 (l)
-  (destructuring-bind (a b c) l
-    (and (= 1 (- b a))
-         (= 1 (- c b)))))
-
-(defun has-straight-3 (nums)
-  (loop-window nums 3 triplet
-               :thereis (is-straight-3 triplet)))
-
-
-(defparameter bad-chars
-  (mapcar #'char-to-num '(#\i #\l #\o)))
-
-(defun no-bad (nums)
-  (loop :for bad :in bad-chars
-        :never (find bad nums)))
-
-
-(defun two-pairs (nums)
-  (-> nums
-      (loop-window 2 (a b)
-                   :when (= a b)
-                   :collect a)
-      remove-duplicates
-      length
-      (>= 2)))
-
-
-(defun valid (nums)
-  (and (has-straight-3 nums)
-       (no-bad nums)
-       (two-pairs nums)
-       nums))
-
-
-(defun incr-nums (nums)
-  (labels ((inc-mod (x)
-             (mod (1+ x) base))
-           (inc (nums)
-             (if (not nums)
-               '(1)
-               (let ((head (inc-mod (car nums))))
-                 (if (zerop head)
-                   (cons head (inc (cdr nums)))
-                   (cons head (cdr nums)))))))
-    (reverse (inc (reverse nums)))))
-
-
-(defun advent-11-1 (data)
-  (flet ((chars-to-string (chs)
-           (apply #'concatenate 'string (mapcar #'string chs)))
-         (nums-to-chars (nums)
-           (mapcar #'num-to-char nums))
-         (string-to-nums (str)
-           (loop :for ch :across str
-                 :collect (char-to-num ch))))
-    (-> (loop :for pw = (incr-nums (string-to-nums data))
-              :then (incr-nums pw)
-              :thereis (valid pw))
-        nums-to-chars
-        chars-to-string)))
-
-
-;;;; Day 12
-(defun advent-12-data ()
-  (beef:trim-whitespace (beef:slurp "data/12")))
-
-
-(defun parse-json (s)
-  (labels ((.number ()
-             (.let* ((negation (.optional (.char= #\-)))
-                     (digits (.first (.one-or-more (.is 'digit-char-p)))))
-               (.identity (let ((i (parse-integer (concatenate 'string digits)))
-                                (c (if negation -1 1)))
-                            (* i c)))))
-           (.string-char ()
-             (.wrap #'list (.is-not 'member (list +quote+))))
-           (.string-guts ()
-             (.let* ((chars (.zero-or-more (.string-char))))
-               (.identity (apply #'concatenate 'string chars))))
-           (.string ()
-             (.prog2
-               (.char= +quote+)
-               (.string-guts)
-               (.char= +quote+)))
-           (.map-pair ()
-             (.let* ((key (.string))
-                     (_ (.char= #\:))
-                     (value (.expression)))
-               (.identity (cons key value))))
-           (.map-guts ()
-             (.or
-               (.let* ((p (.map-pair))
-                       (_ (.char= #\,))
-                       (remaining (.map-guts)))
-                 (.identity (cons p remaining)))
-               (.wrap #'list (.map-pair))
-               (.identity '())))
-           (.map ()
-             (.prog2
-               (.char= #\{)
-               (.wrap (lambda (v) (cons :map v))
-                      (.map-guts))
-               (.char= #\})))
-           (.array-guts ()
-             (.or
-               (.let* ((item (.expression))
-                       (_ (.char= #\,))
-                       (remaining (.array-guts)))
-                 (.identity (cons item remaining)))
-               (.wrap #'list (.expression))
-               (.identity '())))
-           (.array ()
-             (.prog2
-               (.char= #\[)
-               (.wrap (lambda (v) (cons :array v))
-                      (.array-guts))
-               (.char= #\])))
-           (.expression ()
-             (.or (.array)
-                  (.map)
-                  (.string)
-                  (.number))))
-    (parse (.expression) s)))
-
-(defun walk-sum (v)
-  (cond
-    ((not v) 0)
-    ((typep v 'integer) v)
-    ((typep v 'string) 0)
-    ((eql (car v) :array) (loop :for value in (cdr v)
-                                :sum (walk-sum value)))
-    ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
-                              :sum (walk-sum value)))
-    (:else (error (format nil "wat? ~a" v)))))
-
-(defun walk-sum-2 (v)
-  (cond
-    ((not v) 0)
-    ((typep v 'integer) v)
-    ((typep v 'string) 0)
-    ((eql (car v) :array) (loop :for value in (cdr v)
-                                :sum (walk-sum-2 value)))
-    ((eql (car v) :map)
-     (if (member "red" (mapcar #'cdr (cdr v))
-                 :test #'equal)
-       0
-       (loop :for (key . value) :in (cdr v)
-             :sum (walk-sum-2 value))))
-    (:else (error (format nil "wat? ~a" v)))))
-
-
-(defun advent-12-1 (data)
-  (walk-sum (parse-json data)))
-
-(defun advent-12-2 (data)
-  (walk-sum-2 (parse-json data)))
-
-
-;;;; Day 13
-(defun advent-13-data ()
-  (beef:slurp-lines "data/13" :ignore-trailing-newline t))
-
-
-(defvar *wat* nil)
-
-(defmacro map-when (test fn val &rest args)
-  (let ((v (gensym "VALUE")))
-    `(let ((,v ,val))
-       (if ,test
-         (apply ,fn ,v ,args)
-         ,v))))
-
-(defun split-lines-13 (lines)
-  (loop :for line :in lines
-        :collect (ppcre:register-groups-bind
-                   (a dir amount b)
-                   ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
-                    line)
-                   (list a b (map-when (equal "lose" dir)
-                                       #'-
-                                       (parse-integer amount))))))
-
-(defun rate-seating (vals arrangement)
-  (labels ((find-val (a b)
-             (or (gethash (cons a b) vals) 0))
-           (rate-one-direction (arr)
-             (+ (loop-window arr 2 (a b) :sum (find-val a b))
-                (find-val (car (last arr)) (car arr)))))
-    (+ (rate-one-direction arrangement)
-       (rate-one-direction (reverse arrangement)))))
-
-(defun advent-13-1 (data)
-  (let* ((tups (split-lines-13 data))
-         (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
-         (vals (make-hash-table :test #'equal)))
-    (loop :for (a b val) :in tups
-          :do (setf (gethash (cons a b) vals) val))
-    (loop :for arrangement :in (permutations attendees)
-          :maximize (rate-seating vals arrangement))))
-
-(defun advent-13-2 (data)
-  (let* ((tups (split-lines-13 data))
-         (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
-         (vals (make-hash-table :test #'equal)))
-    (loop :for (a b val) :in tups
-          :do (setf (gethash (cons a b) vals) val))
-    (loop :for arrangement :in (permutations attendees)
-          :maximize (rate-seating vals arrangement))))
-
-
-;;;; Day 14
-(defun advent-14-data ()
-  (beef:slurp-lines "data/14" :ignore-trailing-newline t))
-
-
-(defun tick (deer)
-  (destructuring-bind
-    (name speed sprint-period rest-period traveled currently remaining)
-    deer
-    (let ((remaining (1- remaining)))
-      (if (equal currently :resting)
-        (list name speed sprint-period rest-period
-              traveled
-              (if (zerop remaining) :sprinting :resting)
-              (if (zerop remaining) sprint-period remaining))
-        (list name speed sprint-period rest-period
-              (+ traveled speed)
-              (if (zerop remaining) :resting :sprinting)
-              (if (zerop remaining) rest-period remaining))))))
-
-(defun parse-deers (lines)
-  (loop :for line :in lines
-        :collect (ppcre:register-groups-bind
-                   (name speed sprint-period rest-period)
-                   ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
-                    line)
-                   (list name
-                         (parse-integer speed)
-                         (parse-integer sprint-period)
-                         (parse-integer rest-period)
-                         0
-                         :sprinting
-                         (parse-integer sprint-period)))))
-
-(defun find-leaders (deers)
-  (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
-    (remove-if-not (lambda (deer)
-                     (= dist (nth 4 deer)))
-                   deers)))
-
-
-(defun advent-14-1 (data n)
-  (apply #'max
-         (loop :for i :upto n
-               :for deers := (parse-deers data) :then (mapcar #'tick deers)
-               :finally (return (mapcar (beef:partial #'nth 4) deers)))))
-
-(defun advent-14-2 (data n)
-  (let ((scores (make-hash-table :test #'equal))
-        (deers (parse-deers data)))
-    (loop :for (name) :in deers
-          :do (setf (gethash name scores) 0))
-    (loop :for i :upto n
-          :do (setf deers (mapcar #'tick deers))
-          :do (loop :for (name) :in (find-leaders deers)
-                    :do (incf (gethash name scores))))
-    (apply #'max (beef:hash-values scores))))
-
-
-
-;;;; Day 15
-(defun advent-15-data ()
-  (beef:slurp-lines "data/15" :ignore-trailing-newline t))
-
-(defun split-ingredients (line)
-  (ppcre:register-groups-bind
-    (name (#'parse-integer capacity durability flavor texture calories))
-    ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
-     line)
-    (list name capacity durability flavor texture calories)))
-
-(defun calc-contribution (ingr amount)
-  (cons (car ingr)
-        (mapcar (beef:partial #'* amount)
-                (cdr ingr))))
-
-(defun calc-contributions (ingrs alist)
-  (mapcar #'calc-contribution ingrs alist))
-
-(defun sum-totals (ingrs)
-  (->> ingrs
-       (mapcar #'cdr)
-       (apply #'mapcar #'+)
-       (mapcar (lambda (x) (if (< x 0) 0 x)))))
-
-(defun advent-15-1 (data)
-  (let ((ingredients (mapcar #'split-ingredients data))
-        (limit 100)
-        (amounts (list)))
-    ; fuckin lol
-    (loop :for a :upto limit :do
-          (loop :for b :upto (- limit a) :do
-                (loop :for c :upto (- limit a b) :do
-                      (setf amounts
-                            (cons (list a b c (- limit a b c))
-                                  amounts)))))
-    (loop :for alist :in amounts
-          :maximize (->> alist
-                         (calc-contributions ingredients)
-                         sum-totals
-                         butlast
-                         (apply #'*)))))
-
-(defun advent-15-2 (data)
-  (let ((ingredients (mapcar #'split-ingredients data))
-        (limit 100)
-        (amounts (list)))
-    ; fuckin lol
-    (loop :for a :upto limit :do
-          (loop :for b :upto (- limit a) :do
-                (loop :for c :upto (- limit a b) :do
-                      (setf amounts
-                            (cons (list a b c (- limit a b c))
-                                  amounts)))))
-    (loop :for alist :in amounts
-          :for val = (->> alist
-                          (calc-contributions ingredients)
-                          sum-totals)
-          :when (= (car (last val)) 500)
-          :maximize (apply #'* (butlast val)))))
-
-
-;;;; Scratch
-#+comment
-(advent-15-2 (advent-15-data))
diff -r 5e8fb9b8a553 -r 11607ca439c4 src/2015/2015.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2015/2015.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -0,0 +1,898 @@
+; https://bitbucket.org/sjl/beef
+(ql:quickload "beef")
+(ql:quickload "alexandria")
+(ql:quickload "split-sequence")
+(ql:quickload "cl-arrows")
+(ql:quickload "fset")
+(ql:quickload "cl-ppcre")
+(ql:quickload "ironclad")
+(ql:quickload "smug")
+(ql:quickload "bit-smasher")
+(ql:quickload "optima")
+
+(defpackage #:advent
+  (:use #:cl)
+  (:use #:cl-arrows)
+  (:use #:split-sequence)
+  (:use #:smug))
+
+(in-package #:advent)
+
+(declaim (optimize (debug 3)))
+
+;;;; Day 1
+(defun instruction-to-num (ch)
+  (cond
+    ((eql ch #\() 1)
+    ((eql ch #\)) -1)
+    (t 0)))
+
+(defun advent-1-1 ()
+  (loop :for c :across (beef:slurp "data/1")
+        :sum (instruction-to-num c)))
+
+(defun advent-1-2 ()
+  (loop :for c :across (beef:slurp "data/1")
+        :sum (instruction-to-num c) :into floor
+        :sum 1
+        :until (= floor -1)))
+
+
+;;;; Day 2
+(defun advent-2-data ()
+  (->> (beef:slurp "data/2")
+       beef:trim-whitespace-right
+       beef:split-lines
+       (mapcar (lambda (s)
+                 (->> s
+                      (split-sequence #\x)
+                      (mapcar #'parse-integer))))))
+
+(defun advent-2-1 ()
+  (loop :for dims :in (advent-2-data)
+        :for (w h l) = dims
+        :for sides = (list (* w h)
+                           (* w l)
+                           (* h l))
+        :for paper = (* 2 (apply #'+ sides))
+        :for slack = (apply #'min sides)
+        :sum (+ paper slack)))
+
+(defun advent-2-2 ()
+  (loop :for dims :in (advent-2-data)
+        :for (w h l) = dims
+        :for sides = (list (* 2 (+ w h))
+                           (* 2 (+ w l))
+                           (* 2 (+ h l)))
+        :for ribbon = (apply #'min sides)
+        :for bow = (apply #'* dims)
+        :sum (+ ribbon bow)))
+
+
+;;;; Day 3
+(defun advent-3-data ()
+  (beef:trim-whitespace (beef:slurp "data/3")))
+
+(defun instruction-to-offsets (instruction)
+  (case instruction
+    (#\> '(1 0))
+    (#\< '(-1 0))
+    (#\^ '(0 1))
+    (#\v '(0 -1))))
+
+(defun step-santa (loc dir)
+  (destructuring-bind (x y) loc
+    (destructuring-bind (dx dy) (instruction-to-offsets dir)
+      (list (+ x dx) (+ y dy)))))
+
+(defun houses (data)
+  (loop
+    :with loc = '(0 0)
+    :with visited = (fset:set '(0 0))
+    :for dir :across data
+    :do (setq loc (step-santa loc dir))
+    :do (fset:includef visited loc)
+    :finally (return visited)))
+
+(defun advent-3-1 (data)
+  (fset:size (houses data)))
+
+(defun advent-3-2 (data)
+  (fset:size
+    (fset:union
+      ;                                 come directly at me
+      (houses (ppcre:regex-replace-all "(.)." data "\\1"))
+      (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
+
+
+;;;; Day 4
+(defun advent-4-data ()
+  "ckczppom")
+
+(defun md5 (str)
+  (ironclad:byte-array-to-hex-string
+    (ironclad:digest-sequence :md5
+                              (ironclad:ascii-string-to-byte-array str))))
+
+(defun mine (data zeroes)
+  (let ((target (apply #'concatenate 'string
+                       (loop :repeat zeroes :collect "0"))))
+    (loop :for i :upfrom 1
+          :for hash = (->> i
+                           prin1-to-string
+                           (concatenate 'string data)
+                           md5)
+          :until (equal target (subseq hash 0 zeroes))
+          :finally (return i))))
+
+(defun advent-4-1 (data)
+  (mine data 5))
+
+(defun advent-4-2 (data)
+  (mine data 6))
+
+
+;;;; Day 5
+(defun advent-5-data ()
+  (-> "data/5"
+      beef:slurp
+      beef:trim-whitespace-right
+      beef:split-lines))
+
+(defun join-strings (strings delim)
+  "Join strings into a single string with the given delimiter string interleaved.
+
+   Delim must not contain a ~.
+
+   "
+  (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
+
+
+(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
+
+(defun count-vowels (s)
+  (length (ppcre:regex-replace-all "[^aeiou]" s "")))
+
+(defun has-run (s)
+  (when (ppcre:scan "(.)\\1" s) t))
+
+(defun has-bad (s)
+  (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
+
+(defun is-nice (s)
+  (and (>= (count-vowels s) 3)
+       (has-run s)
+       (not (has-bad s))))
+
+(defun advent-5-1 (data)
+  (count-if #'is-nice data))
+
+(defun has-run-2 (s)
+  (when (ppcre:scan "(..).*\\1" s) t))
+
+(defun has-repeat (s)
+  (when (ppcre:scan "(.).\\1" s) t))
+
+(defun is-nice-2 (s)
+  (and (has-run-2 s)
+       (has-repeat s)))
+
+(defun advent-5-2 (data)
+  (count-if #'is-nice-2 data))
+
+
+;;;; Day 6
+(defun advent-6-data ()
+  (beef:slurp-lines "data/6" :ignore-trailing-newline t))
+
+(defmacro loop-array (arr name &rest body)
+  (let ((i (gensym "index")))
+    `(loop :for ,i :below (array-total-size ,arr)
+           :for ,name = (row-major-aref ,arr ,i)
+           ,@body)))
+
+(defun parse-indexes (s)
+  (->> s
+       (split-sequence #\,)
+       (mapcar #'parse-integer)))
+
+(defun flip (b)
+  (if (zerop b) 1 0))
+
+(defun parse-line (line)
+  (let ((parts (split-sequence #\space line)))
+    (list (parse-indexes (beef:index parts -3))
+          (parse-indexes (beef:index parts -1))
+          (cond
+            ((equal (car parts) "toggle") :toggle)
+            ((equal (cadr parts) "on") :on)
+            ((equal (cadr parts) "off") :off)
+            (t (error "Unknown operation!"))))))
+
+(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
+  `(loop :for ,r :from ,from-row :to ,to-row
+         :do (loop :for ,c :from ,from-col :to ,to-col
+                   ,@body)))
+
+(defun advent-6-1 (data)
+  (let ((lights (make-array '(1000 1000) :element-type 'bit)))
+    (loop
+      :for line :in data
+      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+      :do (loop-square
+            r c from-row from-col to-row to-col
+            :do (setf (bit lights r c)
+                      (case operation
+                        (:toggle (flip (bit lights r c)))
+                        (:on 1)
+                        (:off 0)
+                        (t 0)))))
+    (loop-array lights b
+                :sum b)))
+
+(defun advent-6-2 (data)
+  (let ((lights (make-array '(1000 1000) :element-type 'integer)))
+    (loop
+      :for line :in data
+      :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+      :do (loop-square
+            r c from-row from-col to-row to-col
+            :do (case operation
+                  (:toggle (incf (aref lights r c) 2))
+                  (:on (incf (aref lights r c)))
+                  (:off (when (not (zerop (aref lights r c)))
+                          (decf (aref lights r c)))))))
+    (loop-array lights b
+                :sum b)))
+
+
+;;;; Day 7
+(defun advent-7-data ()
+  (beef:slurp-lines "data/7" :ignore-trailing-newline t))
+
+(defun advent-7-2-data ()
+  (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
+
+(defun int->bits (i)
+  (bitsmash:bits<- (format nil "~4,'0X" i)))
+
+(defun bit-lshift (bit-array distance)
+  (replace (make-array (length bit-array) :element-type 'bit)
+           bit-array
+           :start1 0
+           :start2 (bitsmash:int<- distance)))
+
+(defun bit-rshift (bit-array distance)
+  (let ((width (length bit-array))
+        (distance (bitsmash:int<- distance)))
+    (replace (make-array width :element-type 'bit)
+             bit-array
+             :start1 distance
+             :end2 (- width distance))))
+
+(defun .zero-or-more (parser)
+  (.plus (.let* ((x parser)
+                 (xs (.zero-or-more parser)))
+           (.identity (cons x xs)))
+         (.identity ())))
+
+(defun .one-or-more (parser)
+  (.let* ((x parser)
+          (y (.zero-or-more parser)))
+    (.identity (cons x y))))
+
+(defun parse-7 (line)
+  (labels ((.whitespace ()
+             (.first (.one-or-more (.is 'member '(#\space #\tab)))))
+           (.arrow ()
+             (.first (.string= "->")))
+           (.number ()
+             (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
+                    (.identity (parse-integer (concatenate 'string digits)))))
+           (.wire ()
+             (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
+                    (.identity (concatenate 'string chars))))
+           (.source ()
+             (.or (.wire) (.number)))
+           (.string-choice (strs)
+             (if (not strs)
+               (.fail)
+               (.or (.string= (car strs))
+                    (.string-choice (cdr strs)))))
+           (.dest ()
+             (.progn (.whitespace) (.arrow) (.whitespace)
+                     (.wire)))
+           (.constant-source ()
+             (.let* ((val (.source)))
+                    (.identity (list #'identity (list val)))))
+           (.binary-op ()
+             (let ((ops '(("AND" . bit-and)
+                          ("OR" . bit-ior)
+                          ("LSHIFT" . bit-lshift)
+                          ("RSHIFT" . bit-rshift))))
+               (.let* ((name (.string-choice (mapcar #'car ops))))
+                      (.identity (cdr (assoc name ops :test #'equal))))))
+           (.binary-source ()
+             (.let* ((left (.source))
+                     (_ (.whitespace))
+                     (op (.binary-op))
+                     (_ (.whitespace))
+                     (right (.source)))
+                    (.identity (list op (list left right)))))
+           (.unary-op ()
+             (.let* ((_ (.string= "NOT")))
+                    (.identity #'bit-not)))
+           (.unary-source ()
+             (.let* ((op (.unary-op))
+                     (_ (.whitespace))
+                     (source (.source)))
+                    (.identity (list op (list source)))))
+           (.instruction ()
+             (.let* ((source (.or (.binary-source)
+                                  (.unary-source)
+                                  (.constant-source)))
+                     (dest (.dest)))
+                    (.identity (concatenate 'list source (list dest))))))
+    (parse (.instruction) line)))
+
+(defun advent-7-1 (data)
+  (let ((circuit (make-hash-table :test #'equal))
+        (commands (mapcar #'parse-7 data)))
+    (labels ((retrieve (source)
+               (cond
+                 ((stringp source) (gethash source circuit))
+                 ((integerp source) (int->bits source))
+                 (t (error "what?"))))
+             (ready (args)
+               (every #'identity args))
+             (perform (fn args dest)
+               (setf (gethash dest circuit)
+                     (apply fn args)))
+             (try-command (command)
+               "If the command is ready to go, run it and return nil.  Otherwise,
+                return the command itself."
+               (destructuring-bind (fn args dest) command
+                 (let ((vals (mapcar #'retrieve args)))
+                   (if (ready vals)
+                     (progn
+                       (perform fn vals dest)
+                       nil)
+                     command)))))
+      (loop :while commands
+            :do (setf commands
+                  (loop :for command :in commands
+                        :when (try-command command)
+                        :collect :it)))
+      (bitsmash:bits->int (gethash "a" circuit)))))
+
+
+;;;; Day 8
+(defun advent-8-data ()
+  (beef:slurp-lines "data/8" :ignore-trailing-newline t))
+
+
+(defconstant +backslash+ #\\ )
+(defconstant +quote+ #\" )
+
+(defun parse-8 (line)
+  (labels ((.hex-digit ()
+             (.or
+               (.is #'digit-char-p)
+               (.is #'member '(#\a #\b #\c #\d #\e #\f))))
+           (.hex-escape ()
+             (.let* ((_ (.char= #\x))
+                     (a (.hex-digit))
+                     (b (.hex-digit)))
+                    (.identity
+                      (->> (format nil "~A~A" a b)
+                           bitsmash:hex->int
+                           code-char))))
+           (.escaped-char ()
+             (.progn
+               (.char= +backslash+)
+               (.or (.char= +backslash+)
+                    (.char= +quote+)
+                    (.hex-escape))))
+           (.normal-char ()
+             (.is-not 'member (list +backslash+ +quote+)))
+           (.string-char ()
+             (.or (.normal-char)
+                  (.escaped-char)))
+           (.full-string ()
+             (.prog2
+               (.char= +quote+)
+               (.first (.zero-or-more (.string-char)))
+               (.char= +quote+))))
+    (parse (.full-string) line)))
+
+(defun .wrap (fn parser)
+  (.let* ((v parser))
+         (.identity (funcall fn v))))
+
+(defun parse-8-2 (line)
+  (labels ((.special-char ()
+             (.let* ((ch (.or (.char= +backslash+)
+                              (.char= +quote+))))
+                    (.identity (list +backslash+ ch))))
+           (.normal-char ()
+             (.wrap #'list
+                    (.is-not 'member (list +backslash+ +quote+))))
+           (.string-char ()
+             (.or (.normal-char)
+                  (.special-char)))
+           (.full-string ()
+             (.let* ((chars (.zero-or-more (.string-char))))
+                    (.identity (apply #'concatenate 'list chars)))))
+    (append (list +quote+)
+            (parse (.full-string) line)
+            (list +quote+))))
+
+(defun advent-8-1 (data)
+  (loop :for line :in data
+        :for chars = (parse-8 line)
+        :sum (- (length line)
+                (length chars))))
+
+(defun advent-8-2 (data)
+  (loop :for line :in data
+        :for chars = (parse-8-2 line)
+        :sum (- (length chars)
+                (length line))))
+
+
+;;;; Day 9
+(defun advent-9-data ()
+  (beef:slurp-lines "data/9" :ignore-trailing-newline t))
+
+; Thanks Norvig
+; http://norvig.com/paip/gps.lisp
+(defun permutations (bag)
+  "Return a list of all the permutations of the input."
+  ;; If the input is nil, there is only one permutation:
+  ;; nil itself
+  (if (null bag)
+      '(())
+      ;; Otherwise, take an element, e, out of the bag.
+      ;; Generate all permutations of the remaining elements,
+      ;; And add e to the front of each of these.
+      ;; Do this for all possible e to generate all permutations.
+      (mapcan #'(lambda (e)
+                  (mapcar #'(lambda (p) (cons e p))
+                          (permutations
+                            (remove e bag :count 1 :test #'eq))))
+              bag)))
+
+(defun advent-9 (data)
+  (let ((distances (make-hash-table :test #'equal)))
+    (loop :for line :in data
+          :for (a to b _ dist) = (split-sequence #\space line)
+          :for distance = (parse-integer dist)
+          :do (progn
+                (setf (gethash (cons a b) distances) distance)
+                (setf (gethash (cons b a) distances) distance)))
+    (labels ((score-route (route)
+               (optima:match route
+                 ((list _) 0)
+                 ((list* a b _) (+ (gethash (cons a b) distances)
+                                   (score-route (cdr route))))))
+             (dedupe (l)
+               (remove-duplicates l :test #'equal)))
+      (loop :for route :in (->> distances
+                             beef:hash-keys
+                             (mapcar #'car)
+                             dedupe
+                             permutations)
+            :for score = (score-route route)
+            :minimizing score :into min-dist
+            :maximizing score :into max-dist
+            :finally (return (cons min-dist max-dist))))))
+
+
+(defmethod print-object ((object hash-table) stream)
+  (format stream "#HASH{~%~{~{    (~s : ~s)~}~%~}}"
+          (loop for key being the hash-keys of object
+                using (hash-value value)
+                collect (list key value))))
+
+
+;;;; Day 10
+(defun advent-10-data ()
+  "1321131112")
+
+(defun look-and-say (seq)
+  (let ((runs (list))
+        (len 1)
+        (current -1))
+    (flet ((mark-run ()
+             (setf runs (cons current (cons len runs)))))
+    (loop :for n :in seq
+          :do (if (= current n)
+                (incf len)
+                (progn
+                  (when (not (= -1 current))
+                    (mark-run))
+                  (setf len 1)
+                  (setf current n)))
+          :finally (mark-run))
+    (reverse runs))))
+
+(defun iterate (n f data)
+  (declare (optimize speed (debug 0)))
+  (dotimes (_ n)
+    (setf data (funcall f data)))
+  data)
+
+(defun las-to-list (s)
+  (loop :for digit :across s
+        :collect (-> digit string parse-integer)))
+
+(defun advent-10-1 (data)
+  (length (iterate 40 #'look-and-say (las-to-list data))))
+
+(defun advent-10-2 (data)
+  (length (iterate 50 #'look-and-say (las-to-list data))))
+
+
+;;;; Day 11
+(defun advent-11-data ()
+  "vzbxkghb")
+
+
+(defparameter base 26)
+(defparameter ascii-alpha-start (char-code #\a))
+(defun num-to-char (n)
+  (code-char (+ n ascii-alpha-start)))
+
+(defun char-to-num (ch)
+  (- (char-code ch) ascii-alpha-start))
+
+
+(defmacro loop-window (seq width binding-form &rest body)
+  (let ((i (gensym "IGNORE"))
+        (s (gensym "SEQ"))
+        (n (gensym "WIDTH"))
+        (tail (gensym "TAIL")))
+    `(let ((,s ,seq)
+           (,n ,width))
+       (loop :for ,i :upto (- (length ,s) ,n)
+             :for ,tail :on ,s
+             :for ,binding-form = (subseq ,tail 0 ,n)
+             ,@body))))
+
+
+(defun is-straight-3 (l)
+  (destructuring-bind (a b c) l
+    (and (= 1 (- b a))
+         (= 1 (- c b)))))
+
+(defun has-straight-3 (nums)
+  (loop-window nums 3 triplet
+               :thereis (is-straight-3 triplet)))
+
+
+(defparameter bad-chars
+  (mapcar #'char-to-num '(#\i #\l #\o)))
+
+(defun no-bad (nums)
+  (loop :for bad :in bad-chars
+        :never (find bad nums)))
+
+
+(defun two-pairs (nums)
+  (-> nums
+      (loop-window 2 (a b)
+                   :when (= a b)
+                   :collect a)
+      remove-duplicates
+      length
+      (>= 2)))
+
+
+(defun valid (nums)
+  (and (has-straight-3 nums)
+       (no-bad nums)
+       (two-pairs nums)
+       nums))
+
+
+(defun incr-nums (nums)
+  (labels ((inc-mod (x)
+             (mod (1+ x) base))
+           (inc (nums)
+             (if (not nums)
+               '(1)
+               (let ((head (inc-mod (car nums))))
+                 (if (zerop head)
+                   (cons head (inc (cdr nums)))
+                   (cons head (cdr nums)))))))
+    (reverse (inc (reverse nums)))))
+
+
+(defun advent-11-1 (data)
+  (flet ((chars-to-string (chs)
+           (apply #'concatenate 'string (mapcar #'string chs)))
+         (nums-to-chars (nums)
+           (mapcar #'num-to-char nums))
+         (string-to-nums (str)
+           (loop :for ch :across str
+                 :collect (char-to-num ch))))
+    (-> (loop :for pw = (incr-nums (string-to-nums data))
+              :then (incr-nums pw)
+              :thereis (valid pw))
+        nums-to-chars
+        chars-to-string)))
+
+
+;;;; Day 12
+(defun advent-12-data ()
+  (beef:trim-whitespace (beef:slurp "data/12")))
+
+
+(defun parse-json (s)
+  (labels ((.number ()
+             (.let* ((negation (.optional (.char= #\-)))
+                     (digits (.first (.one-or-more (.is 'digit-char-p)))))
+               (.identity (let ((i (parse-integer (concatenate 'string digits)))
+                                (c (if negation -1 1)))
+                            (* i c)))))
+           (.string-char ()
+             (.wrap #'list (.is-not 'member (list +quote+))))
+           (.string-guts ()
+             (.let* ((chars (.zero-or-more (.string-char))))
+               (.identity (apply #'concatenate 'string chars))))
+           (.string ()
+             (.prog2
+               (.char= +quote+)
+               (.string-guts)
+               (.char= +quote+)))
+           (.map-pair ()
+             (.let* ((key (.string))
+                     (_ (.char= #\:))
+                     (value (.expression)))
+               (.identity (cons key value))))
+           (.map-guts ()
+             (.or
+               (.let* ((p (.map-pair))
+                       (_ (.char= #\,))
+                       (remaining (.map-guts)))
+                 (.identity (cons p remaining)))
+               (.wrap #'list (.map-pair))
+               (.identity '())))
+           (.map ()
+             (.prog2
+               (.char= #\{)
+               (.wrap (lambda (v) (cons :map v))
+                      (.map-guts))
+               (.char= #\})))
+           (.array-guts ()
+             (.or
+               (.let* ((item (.expression))
+                       (_ (.char= #\,))
+                       (remaining (.array-guts)))
+                 (.identity (cons item remaining)))
+               (.wrap #'list (.expression))
+               (.identity '())))
+           (.array ()
+             (.prog2
+               (.char= #\[)
+               (.wrap (lambda (v) (cons :array v))
+                      (.array-guts))
+               (.char= #\])))
+           (.expression ()
+             (.or (.array)
+                  (.map)
+                  (.string)
+                  (.number))))
+    (parse (.expression) s)))
+
+(defun walk-sum (v)
+  (cond
+    ((not v) 0)
+    ((typep v 'integer) v)
+    ((typep v 'string) 0)
+    ((eql (car v) :array) (loop :for value in (cdr v)
+                                :sum (walk-sum value)))
+    ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
+                              :sum (walk-sum value)))
+    (:else (error (format nil "wat? ~a" v)))))
+
+(defun walk-sum-2 (v)
+  (cond
+    ((not v) 0)
+    ((typep v 'integer) v)
+    ((typep v 'string) 0)
+    ((eql (car v) :array) (loop :for value in (cdr v)
+                                :sum (walk-sum-2 value)))
+    ((eql (car v) :map)
+     (if (member "red" (mapcar #'cdr (cdr v))
+                 :test #'equal)
+       0
+       (loop :for (key . value) :in (cdr v)
+             :sum (walk-sum-2 value))))
+    (:else (error (format nil "wat? ~a" v)))))
+
+
+(defun advent-12-1 (data)
+  (walk-sum (parse-json data)))
+
+(defun advent-12-2 (data)
+  (walk-sum-2 (parse-json data)))
+
+
+;;;; Day 13
+(defun advent-13-data ()
+  (beef:slurp-lines "data/13" :ignore-trailing-newline t))
+
+
+(defvar *wat* nil)
+
+(defmacro map-when (test fn val &rest args)
+  (let ((v (gensym "VALUE")))
+    `(let ((,v ,val))
+       (if ,test
+         (apply ,fn ,v ,args)
+         ,v))))
+
+(defun split-lines-13 (lines)
+  (loop :for line :in lines
+        :collect (ppcre:register-groups-bind
+                   (a dir amount b)
+                   ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
+                    line)
+                   (list a b (map-when (equal "lose" dir)
+                                       #'-
+                                       (parse-integer amount))))))
+
+(defun rate-seating (vals arrangement)
+  (labels ((find-val (a b)
+             (or (gethash (cons a b) vals) 0))
+           (rate-one-direction (arr)
+             (+ (loop-window arr 2 (a b) :sum (find-val a b))
+                (find-val (car (last arr)) (car arr)))))
+    (+ (rate-one-direction arrangement)
+       (rate-one-direction (reverse arrangement)))))
+
+(defun advent-13-1 (data)
+  (let* ((tups (split-lines-13 data))
+         (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
+         (vals (make-hash-table :test #'equal)))
+    (loop :for (a b val) :in tups
+          :do (setf (gethash (cons a b) vals) val))
+    (loop :for arrangement :in (permutations attendees)
+          :maximize (rate-seating vals arrangement))))
+
+(defun advent-13-2 (data)
+  (let* ((tups (split-lines-13 data))
+         (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
+         (vals (make-hash-table :test #'equal)))
+    (loop :for (a b val) :in tups
+          :do (setf (gethash (cons a b) vals) val))
+    (loop :for arrangement :in (permutations attendees)
+          :maximize (rate-seating vals arrangement))))
+
+
+;;;; Day 14
+(defun advent-14-data ()
+  (beef:slurp-lines "data/14" :ignore-trailing-newline t))
+
+
+(defun tick (deer)
+  (destructuring-bind
+    (name speed sprint-period rest-period traveled currently remaining)
+    deer
+    (let ((remaining (1- remaining)))
+      (if (equal currently :resting)
+        (list name speed sprint-period rest-period
+              traveled
+              (if (zerop remaining) :sprinting :resting)
+              (if (zerop remaining) sprint-period remaining))
+        (list name speed sprint-period rest-period
+              (+ traveled speed)
+              (if (zerop remaining) :resting :sprinting)
+              (if (zerop remaining) rest-period remaining))))))
+
+(defun parse-deers (lines)
+  (loop :for line :in lines
+        :collect (ppcre:register-groups-bind
+                   (name speed sprint-period rest-period)
+                   ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
+                    line)
+                   (list name
+                         (parse-integer speed)
+                         (parse-integer sprint-period)
+                         (parse-integer rest-period)
+                         0
+                         :sprinting
+                         (parse-integer sprint-period)))))
+
+(defun find-leaders (deers)
+  (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
+    (remove-if-not (lambda (deer)
+                     (= dist (nth 4 deer)))
+                   deers)))
+
+
+(defun advent-14-1 (data n)
+  (apply #'max
+         (loop :for i :upto n
+               :for deers := (parse-deers data) :then (mapcar #'tick deers)
+               :finally (return (mapcar (beef:partial #'nth 4) deers)))))
+
+(defun advent-14-2 (data n)
+  (let ((scores (make-hash-table :test #'equal))
+        (deers (parse-deers data)))
+    (loop :for (name) :in deers
+          :do (setf (gethash name scores) 0))
+    (loop :for i :upto n
+          :do (setf deers (mapcar #'tick deers))
+          :do (loop :for (name) :in (find-leaders deers)
+                    :do (incf (gethash name scores))))
+    (apply #'max (beef:hash-values scores))))
+
+
+
+;;;; Day 15
+(defun advent-15-data ()
+  (beef:slurp-lines "data/15" :ignore-trailing-newline t))
+
+(defun split-ingredients (line)
+  (ppcre:register-groups-bind
+    (name (#'parse-integer capacity durability flavor texture calories))
+    ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
+     line)
+    (list name capacity durability flavor texture calories)))
+
+(defun calc-contribution (ingr amount)
+  (cons (car ingr)
+        (mapcar (beef:partial #'* amount)
+                (cdr ingr))))
+
+(defun calc-contributions (ingrs alist)
+  (mapcar #'calc-contribution ingrs alist))
+
+(defun sum-totals (ingrs)
+  (->> ingrs
+       (mapcar #'cdr)
+       (apply #'mapcar #'+)
+       (mapcar (lambda (x) (if (< x 0) 0 x)))))
+
+(defun advent-15-1 (data)
+  (let ((ingredients (mapcar #'split-ingredients data))
+        (limit 100)
+        (amounts (list)))
+    ; fuckin lol
+    (loop :for a :upto limit :do
+          (loop :for b :upto (- limit a) :do
+                (loop :for c :upto (- limit a b) :do
+                      (setf amounts
+                            (cons (list a b c (- limit a b c))
+                                  amounts)))))
+    (loop :for alist :in amounts
+          :maximize (->> alist
+                         (calc-contributions ingredients)
+                         sum-totals
+                         butlast
+                         (apply #'*)))))
+
+(defun advent-15-2 (data)
+  (let ((ingredients (mapcar #'split-ingredients data))
+        (limit 100)
+        (amounts (list)))
+    ; fuckin lol
+    (loop :for a :upto limit :do
+          (loop :for b :upto (- limit a) :do
+                (loop :for c :upto (- limit a b) :do
+                      (setf amounts
+                            (cons (list a b c (- limit a b c))
+                                  amounts)))))
+    (loop :for alist :in amounts
+          :for val = (->> alist
+                          (calc-contributions ingredients)
+                          sum-totals)
+          :when (= (car (last val)) 500)
+          :maximize (apply #'* (butlast val)))))
+
+
+;;;; Scratch
+#+comment
+(advent-15-2 (advent-15-data))
diff -r 5e8fb9b8a553 -r 11607ca439c4 src/main.lisp
--- a/src/main.lisp	Sat Dec 02 12:49:22 2017 -0500
+++ b/src/main.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -51,3 +51,30 @@
              (somelist #'head-valid-p line)))
     (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
                :key #'checksum)))
+
+
+(defun day-3-part-1 ()
+  (labels ((manhattan-distance (a b)
+             (+ (abs (- (realpart a)
+                        (realpart b)))
+                (abs (- (imagpart a)
+                        (imagpart b)))))
+           (distance-to-origin (p)
+             (manhattan-distance #c(0 0) p)))
+    (distance-to-origin (advent.spiral:number-coordinates 325489))))
+
+(defun day-3-part-2 ()
+  (flet ((neighbors (coord)
+           (iterate (for-nested ((dx :from -1 :to 1)
+                                 (dy :from -1 :to 1)))
+                    (unless (= 0 dx dy)
+                      (collect (+ coord (complex dx dy)))))))
+    (iterate
+      (with memory = (make-hash-table))
+      (initially (setf (gethash #c(0 0) memory) 1))
+      (for n :from 2)
+      (for coord = (advent.spiral:number-coordinates n))
+      (for value = (summation (neighbors coord) :key (rcurry #'gethash memory 0)))
+      (finding value :such-that (> value 325489))
+      (setf (gethash coord memory) value))))
+
diff -r 5e8fb9b8a553 -r 11607ca439c4 src/number-spiral.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/number-spiral.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -0,0 +1,86 @@
+(in-package :advent.spiral)
+
+(defun layer-side-length (layer)
+  "Return the length of one side of `layer`."
+  (1+ (* 2 layer)))
+
+(defun layer-size (layer)
+  "Return the total size of a number spiral with a final layer of `layer`."
+  (square (layer-side-length layer)))
+
+(defun layer-for-number (number)
+  "Return the index of the layer containing `number`."
+  (ceiling (/ (1- (sqrt number)) 2)))
+
+(defun layer-start (layer)
+  "Return the smallest number in `layer`."
+  (if (zerop layer)
+    1
+    (1+ (layer-size (1- layer)))))
+
+(defun layer-leg-length (layer)
+  "Return the length of one \"leg\" of `layer`."
+  (1- (layer-side-length layer)))
+
+
+(defun leg (layer number)
+  "Return the leg index and offset of `number` in `layer`."
+  (if (= 1 number)
+    (values 0 0)
+    (let ((idx (- number (layer-start layer)))
+          (legsize (layer-leg-length layer)))
+      (values (floor idx legsize)
+              (1+ (mod idx legsize))))))
+
+(defun corner-coordinates (layer leg)
+  "Return the coordinates of the corner starting `leg` in `layer`.
+
+  Leg | Corner
+   0  | Bottom Right
+   1  | Top Right
+   2  | Top Left
+   3  | Bottom Left
+
+  "
+
+  ;; 2   1
+  ;;
+  ;; 3   0
+  (ccase leg
+    (0 (complex layer (- layer)))
+    (1 (complex layer layer))
+    (2 (complex (- layer) layer))
+    (3 (complex (- layer) (- layer)))))
+
+(defun leg-direction (leg)
+  "Return the direction vector for the given `leg`.
+  "
+  ;;    <--
+  ;;   11110
+  ;; | 2   0 ^
+  ;; | 2   0 |
+  ;; v 2   0 |
+  ;;   23333
+  ;;    -->
+  (ccase leg
+    (0 (complex 0 1))
+    (1 (complex -1 0))
+    (2 (complex 0 -1))
+    (3 (complex 1 0))))
+
+
+(defun number-coordinates (number)
+  (nest
+    ;; Find the layer the number falls in.
+    (let ((layer (layer-for-number number))))
+
+    ;; Find which leg of that layer it's in, and how far along the leg it is.
+    (multiple-value-bind (leg offset) (leg layer number))
+
+    ;; Find the coordinates of the leg's corner, and its direction vector.
+    (let ((corner (corner-coordinates layer leg))
+          (direction (leg-direction leg))))
+
+    ;; Start at the corner and add the offset in the leg's direction to find the
+    ;; number's coordinates.
+    (+ corner (* direction offset))))
diff -r 5e8fb9b8a553 -r 11607ca439c4 vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Sat Dec 02 12:49:22 2017 -0500
+++ b/vendor/make-quickutils.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -6,6 +6,8 @@
 
                :curry
                :rcurry
+               :range
+               :compose
                :read-file-into-string
 
                )
diff -r 5e8fb9b8a553 -r 11607ca439c4 vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Sat Dec 02 12:49:22 2017 -0500
+++ b/vendor/quickutils.lisp	Sun Dec 03 18:39:45 2017 -0500
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :RCURRY :READ-FILE-INTO-STRING) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :RCURRY :RANGE :COMPOSE :READ-FILE-INTO-STRING) :ensure-package T :package "ADVENT.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "ADVENT.QUICKUTILS")
@@ -14,8 +14,9 @@
 
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :CURRY :RCURRY :ONCE-ONLY
-                                         :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
+                                         :CURRY :RCURRY :RANGE :COMPOSE
+                                         :ONCE-ONLY :WITH-OPEN-FILE*
+                                         :WITH-INPUT-FROM-FILE
                                          :READ-FILE-INTO-STRING))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
@@ -71,6 +72,43 @@
         (multiple-value-call fn (values-list more) (values-list arguments)))))
   
 
+  (defun range (start end &key (step 1) (key 'identity))
+    "Return the list of numbers `n` such that `start <= n < end` and
+`n = start + k*step` for suitable integers `k`. If a function `key` is
+provided, then apply it to each number."
+    (assert (<= start end))
+    (loop :for i :from start :below end :by step :collecting (funcall key i)))
+  
+
+  (defun compose (function &rest more-functions)
+    "Returns a function composed of `function` and `more-functions` that applies its ;
+arguments to to each in turn, starting from the rightmost of `more-functions`,
+and then calling the next one with the primary value of the last."
+    (declare (optimize (speed 3) (safety 1) (debug 1)))
+    (reduce (lambda (f g)
+              (let ((f (ensure-function f))
+                    (g (ensure-function g)))
+                (lambda (&rest arguments)
+                  (declare (dynamic-extent arguments))
+                  (funcall f (apply g arguments)))))
+            more-functions
+            :initial-value function))
+
+  (define-compiler-macro compose (function &rest more-functions)
+    (labels ((compose-1 (funs)
+               (if (cdr funs)
+                   `(funcall ,(car funs) ,(compose-1 (cdr funs)))
+                   `(apply ,(car funs) arguments))))
+      (let* ((args (cons function more-functions))
+             (funs (make-gensym-list (length args) "COMPOSE")))
+        `(let ,(loop for f in funs for arg in args
+                     collect `(,f (ensure-function ,arg)))
+           (declare (optimize (speed 3) (safety 1) (debug 1)))
+           (lambda (&rest arguments)
+             (declare (dynamic-extent arguments))
+             ,(compose-1 funs))))))
+  
+
   (defmacro once-only (specs &body forms)
     "Evaluates `forms` with symbols specified in `specs` rebound to temporary
 variables, ensuring that each initform is evaluated only once.
@@ -162,6 +200,6 @@
               :while (= bytes-read buffer-size)))))))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(curry rcurry read-file-into-string)))
+  (export '(curry rcurry range compose read-file-into-string)))
 
 ;;;; END OF quickutils.lisp ;;;;