--- a/src/2018/01.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(defpackage :advent/2018/01 #.cl-user::*advent-use*)
-(in-package :advent/2018/01)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(define-problem (2018 1) (data read-all)
- (values
- (summation data)
- (progn
- (setf (cdr (last data)) data) ; make data a circular list for easy looping
- (iterate
- (with seen = (make-hash-set :initial-contents '(0)))
- (for number :in data)
- (summing number :into frequency)
- (if (hset-contains-p seen frequency)
- (return frequency)
- (hset-insert! seen frequency))))))
--- a/src/2018/02.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-(defpackage :advent/2018/02 #.cl-user::*advent-use*)
-(in-package :advent/2018/02)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(define-problem (2018 2) (data read-lines)
- (values
- (let* ((freqs (mapcar #'frequencies data))
- (counts (mapcar #'hash-table-values freqs)))
- (* (count 2 counts :test #'member)
- (count 3 counts :test #'member)))
- ;; just brute force it
- (multiple-value-bind (a b)
- (iterate
- (for (a . remaining) :on data)
- (for b = (find 1 remaining :key (curry #'hamming-distance a)))
- (when b
- (return (values a b))))
- (let ((i (mismatch a b)))
- (str:concat (subseq a 0 i)
- (subseq a (1+ i)))))))
-
-
--- a/src/2018/03.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,44 +0,0 @@
-(defpackage :advent/2018/03 #.cl-user::*advent-use*)
-(in-package :advent/2018/03)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(defstruct claim id left right top bottom)
-(define-with-macro claim id left right top bottom)
-
-(defun parse-claim (line)
- (ppcre:register-groups-bind
- ((#'parse-integer id col row width height))
- (#?r"#(\d+) @ (\d+),(\d+): (\d+)x(\d+)" line)
- (make-claim :id id
- :left col
- :top row
- :right (+ col width)
- :bottom (+ row height))))
-
-(defun claims-intersect-p (claim1 claim2)
- (with-claim (claim1 id1 left1 right1 top1 bottom1)
- (with-claim (claim2 id2 left2 right2 top2 bottom2)
- (not (or (<= right2 left1)
- (<= right1 left2)
- (>= top2 bottom1)
- (>= top1 bottom2))))))
-
-(defun make-fabric (claims)
- (let ((fabric (make-array (list 1000 1000) :initial-element 0)))
- (dolist (claim claims)
- (with-claim (claim)
- (do-range ((row top bottom)
- (col left right))
- (incf (aref fabric row col)))))
- fabric))
-
-
-(define-problem (2018 3) (data read-lines)
- (let* ((claims (mapcar #'parse-claim data))
- (fabric (make-fabric claims)))
- (values
- (iterate (for uses :in-array fabric)
- (counting (> uses 1)))
- (claim-id (first (unique claims :test #'claims-intersect-p))))))
-
--- a/src/2018/04.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,69 +0,0 @@
-(defpackage :advent/2018/04 #.cl-user::*advent-use*)
-(in-package :advent/2018/04)
-(named-readtables:in-readtable :interpol-syntax)
-
-;; This problem gets much easier after you've unlocked the second question and
-;; realize you can solve everything by building histograms of each guard's
-;; sleeping minutes.
-
-(defun parse-line (line)
- "Parse `line` into `(minute :event id?)`"
- (ppcre:register-groups-bind
- ((#'parse-integer minute) event)
- (#?r"\[\d+-\d+-\d+ \d+:(\d+)\] (.*)" line)
- (list* minute
- (cond
- ((string= "falls asleep" event) (list :sleep nil))
- ((string= "wakes up" event) (list :wake nil))
- (t (ppcre:register-groups-bind
- ((#'parse-integer id))
- (#?r"Guard #(\d+) begins shift" event)
- (list :guard id)))))))
-
-(defun sleep-intervals (events &aux start guard)
- "Transform `events` into a list of `(guard-id start end)`"
- (iterate
- (for (minute event id?) :in events)
- (ecase event
- (:guard (setf guard id?))
- (:wake (collect (list guard start minute)))
- (:sleep (setf start minute)))))
-
-(defun guard-histograms (intervals)
- "Return a hash-table of histograms of the guards' sleeping minutes."
- (iterate
- (with result = (make-hash-table))
- (for (guard start end) :in intervals)
- (for histogram = (ensure-gethash guard result
- (make-array 60 :initial-element 0)))
- (do-range ((minute start end))
- (incf (aref histogram minute)))
- (finally (return result))))
-
-
-(define-problem (2018 4) (data read-lines)
- (let ((guard-histograms (-<> data
- (sort <> #'string<)
- (mapcar #'parse-line <>)
- sleep-intervals
- guard-histograms)))
- (nest
- (destructuring-bind
- (sleepy-guard sleepy-guard-preferred-minute)
- (iterate
- (for (guard histogram) :in-hashtable guard-histograms)
- (finding (list guard
- (nth-value 1 (extremum+ histogram #'>)))
- :maximizing (summation histogram))))
- (destructuring-bind
- (predictable-guard predictable-guard-time)
- (iterate
- (for (guard histogram) :in-hashtable guard-histograms)
- (for (values time preferred-minute) = (extremum+ histogram #'>))
- (finding (list guard preferred-minute) :maximizing time)))
- (values (* sleepy-guard
- sleepy-guard-preferred-minute)
- (* predictable-guard
- predictable-guard-time)))))
-
-
--- a/src/2018/05.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-(defpackage :advent/2018/05 #.cl-user::*advent-use*)
-(in-package :advent/2018/05)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defun reactivep (x y)
- (char= x (char-invertcase y)))
-
-(defun react (string &aux result)
- (doseq (char string)
- (if (and result (reactivep char (car result)))
- (pop result)
- (push char result)))
- (coerce (nreverse result) 'string))
-
-(define-problem (2018 5) (data alexandria:read-stream-content-into-string)
- (deletef data #\newline)
- (values
- (length (react data))
- (iterate
- (for unit :in-vector (remove-duplicates data :test #'char-equal))
- (for candidate = (react (remove unit data :test #'char-equal)))
- (minimizing (length candidate)))))
-
-
--- a/src/2018/06.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,45 +0,0 @@
-(defpackage :advent/2018/06 #.cl-user::*advent-use*)
-(in-package :advent/2018/06)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defun parse-line (line)
- (apply #'complex (mapcar #'parse-integer (str:split ", " line))))
-
-(defun closest (point coordinates)
- (let ((results (extremums coordinates '<
- :key (curry #'manhattan-distance point))))
- (case (length results)
- (1 (car results))
- (t nil))))
-
-(define-problem (2018 6) (data read-lines)
- (let* ((coordinates (mapcar #'parse-line data))
- (xs (mapcar #'realpart coordinates))
- (ys (mapcar #'imagpart coordinates))
- (left (extremum xs #'<))
- (bottom (extremum ys #'<))
- (right (extremum xs #'>))
- (top (extremum ys #'>))
- (counts (make-hash-table))
- (infinite (make-hash-set)))
- (iterate
- (for-nested ((x :from left :to right)
- (y :from bottom :to top)))
- (for closest = (closest (complex x y) coordinates))
- (when closest
- (incf (gethash closest counts 0))
- (when (or (= left x) (= bottom y)
- (= right x) (= top y))
- (hset-insert! infinite closest))))
- (values
- (iterate
- (for (point size) :in-hashtable counts)
- (unless (hset-contains-p infinite point)
- (maximizing size)))
- (iterate
- (for-nested ((x :from left :to right)
- (y :from bottom :to top)))
- (for point = (complex x y))
- (for total-distance = (summation coordinates :key (curry #'manhattan-distance point)))
- (counting (< total-distance 10000))))))
-
--- a/src/2018/07.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,62 +0,0 @@
-(defpackage :advent/2018/07 #.cl-user::*advent-use*)
-(in-package :advent/2018/07)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(defun parse-line (line)
- (ppcre:register-groups-bind
- (((rcurry #'aref 0) requirement target))
- (#?r"Step (\w) must be finished before step (\w) can begin." line)
- (list target requirement)))
-
-(defun make-graph (edges)
- (let* ((vertices (remove-duplicates (flatten-once edges)))
- (graph (digraph:make-digraph :initial-vertices vertices)))
- (dolist (edge edges)
- (digraph:insert-edge graph (first edge) (second edge)))
- graph))
-
-(defun char-number (char)
- (1+ (- (char-code char) (char-code #\A))))
-
-(defun task-length (task)
- (+ 60 (char-number task)))
-
-(defun decrement-workers (workers)
- (gathering
- (do-array (worker workers)
- (when worker
- (when (zerop (decf (cdr worker)))
- (gather (car worker))
- (setf worker nil))))))
-
-
-(define-problem (2018 7) (data read-lines)
- (values
- (let ((graph (make-graph (mapcar #'parse-line data))))
- ;; (digraph.dot:draw graph)
- (recursively ((result nil))
- (if (emptyp graph)
- (coerce (nreverse result) 'string)
- (let ((next (extremum (digraph:leafs graph) 'char<)))
- (digraph:remove-vertex graph next)
- (recur (cons next result))))))
- (iterate
- (with graph = (make-graph (mapcar #'parse-line data)))
- ;; workers is a vector of (task . remaining-time), or NILs for idle workers
- (with workers = (make-array 5 :initial-element nil))
- (for elapsed :from 0)
- (for finished-tasks = (decrement-workers workers))
- (map nil (curry #'digraph:remove-vertex graph) finished-tasks)
- (for current-tasks = (remove nil (map 'list #'car workers)))
- (for available-tasks = (-<> graph
- digraph:leafs
- (set-difference <> current-tasks)
- (sort <> 'char<)))
- (do-array (worker workers)
- (when (null worker)
- (when-let ((task (pop available-tasks)))
- (setf worker (cons task (task-length task))))))
- (when (and (emptyp graph) (every #'null workers))
- (return elapsed)))))
-
--- a/src/2018/08.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-(defpackage :advent/2018/08 #.cl-user::*advent-use*)
-(in-package :advent/2018/08)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defstruct (node (:conc-name nil))
- children metadata)
-
-(defun read-node (stream)
- (let ((children-count (read stream))
- (metadata-count (read stream)))
- (make-node :children (iterate
- (repeat children-count)
- (collect (read-node stream) :result-type vector))
- :metadata (iterate
- (repeat metadata-count)
- (collect (read stream))))))
-
-(defun node-value (node &aux (children (children node)))
- (if (emptyp children)
- (summation (metadata node))
- (iterate
- (for meta :in (metadata node))
- (for index = (1- meta))
- (when (array-in-bounds-p children index)
- (summing (node-value (aref children index)))))))
-
-(define-problem (2018 8) (data)
- (let ((root (read-node data)))
- (values
- (recursively ((node root))
- (+ (summation (metadata node))
- (summation (children node) :key #'recur)))
- (node-value root))))
-
--- a/src/2018/09.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-(defpackage :advent/2018/09 #.cl-user::*advent-use*)
-(in-package :advent/2018/09)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(defun parse-input (line)
- (ppcre:register-groups-bind
- ((#'parse-integer players marbles))
- (#?r"(\d+) players\D*(\d+) points" line)
- (values players marbles)))
-
-(defun play (players marbles)
- (let ((circle (ring 0))
- (elves (make-array players :initial-element 0)))
- (iterate
- (declare (iterate:declare-variables))
- (for elf :first 0 :then (mod (1+ elf) players))
- (for marble :from 1 :to marbles)
- (if (dividesp marble 23)
- (progn (incf (aref elves elf) marble)
- (ring-movef circle -7)
- (incf (aref elves elf) (ring-data circle))
- (ring-cutf circle))
- (progn (ring-movef circle 1)
- (ring-insertf-after circle marble))))
- (extremum elves '>)))
-
-
-(define-problem (2018 9) (data alexandria:read-stream-content-into-string)
- (multiple-value-bind (players marbles) (parse-input data)
- #+sbcl (sb-ext:gc :full t)
- (values (play players marbles)
- (play players (* marbles 100)))))
-
--- a/src/2018/10.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-(defpackage :advent/2018/10 #.cl-user::*advent-use*)
-(in-package :advent/2018/10)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defun parse-line (line)
- (destructuring-bind (x y vx vy) line
- (cons (complex x y)
- (complex vx vy))))
-
-(defun x (star)
- (realpart (car star)))
-
-(defun y (star)
- (imagpart (car star)))
-
-(defun tick (stars)
- (dolist (star stars)
- (incf (car star) (cdr star))))
-
-(defun bounds (stars)
- (values (x (extremum stars '< :key #'x)) ; left
- (x (extremum stars '> :key #'x)) ; right
- (y (extremum stars '< :key #'y)) ; bottom
- (y (extremum stars '> :key #'y)))) ; top
-
-(defun field-size (stars)
- (multiple-value-bind (left right bottom top)
- (bounds stars)
- (* (- right left) (- top bottom))))
-
-(defun draw (stars)
- (multiple-value-bind (left right bottom top) (bounds stars)
- (let* ((height (1+ (- top bottom)))
- (width (1+ (- right left)))
- (field (make-array height)))
- (do-array (line field)
- (setf line (make-string width :initial-element #\space)))
- (dolist (star stars)
- (setf (aref (aref field (- (y star) bottom))
- (- (x star) left))
- #\*))
- (map nil #'write-line field))))
-
-(define-problem (2018 10) (data read-lines-of-numbers-and-garbage)
- (iterate
- (with stars = (mapcar #'parse-line data))
- (with ticks = 0)
- (initially (iterate
- (tick stars)
- (incf ticks)
- (until (< (field-size stars) 3000))))
- (format t "After tick ~D:~%" ticks)
- (draw stars)
- (until (string= "q" (read-line)))
- (tick stars)))
-
--- a/src/2018/11.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-(defpackage :advent/2018/11 #.cl-user::*advent-use*)
-(in-package :advent/2018/11)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defun cell (x y)
- (complex x y))
-
-(defun x (cell)
- (realpart cell))
-
-(defun y (cell)
- (imagpart cell))
-
-(defun rack-id (cell)
- (+ (x cell) 10))
-
-(defun power-level (serial-number cell)
- (-<> (rack-id cell)
- (* <> (y cell))
- (+ <> serial-number)
- (* <> (rack-id cell))
- (nth-digit 2 <>)
- (- <> 5)))
-
-(define-problem (2018 11) (serial-number read)
- (let ((totals (make-array (list 300 300))))
- (flet ((gref (x y)
- (let ((x (1- x))
- (y (1- y)))
- (if (array-in-bounds-p totals x y)
- (aref totals x y)
- 0)))
- ((setf gref) (value x y)
- (setf (aref totals (1- x) (1- y)) value)))
- (iterate (for-nested ((x :from 300 :downto 1)
- (y :from 300 :downto 1)))
- (setf (gref x y)
- (+ (power-level serial-number (cell x y))
- (gref (1+ x) y)
- (gref x (1+ y))
- (- (gref (1+ x) (1+ y))))))
- (labels ((square-power (x y n)
- (let ((xn (+ x n))
- (yn (+ y n)))
- (+ (gref x y)
- (- (gref xn y))
- (- (gref x yn))
- (gref xn yn))))
- (largest-square (n)
- (iterate
- (for-nested ((x :from 1 :to (- 301 n))
- (y :from 1 :to (- 301 n))))
- (for power = (square-power x y n))
- (finding (list x y power) :maximizing power))))
- (values (subseq (largest-square 3) 0 2)
- (iterate (for n :from 1 :to 300)
- (for (x y power) = (largest-square n))
- (finding (list x y n) :maximizing power)))))))
-
--- a/src/2018/12.lisp Sat Dec 15 16:52:29 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,99 +0,0 @@
-(defpackage :advent/2018/12 #.cl-user::*advent-use*)
-(in-package :advent/2018/12)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(defstruct pots data min max)
-
-(defmethod print-object ((o pots) s)
- (print-unreadable-object (o s :type t)
- (format s "~D to ~D: ~A" (pots-min o) (pots-max o)
- (iterate (for i :from (pots-min o) :to (pots-max o))
- (collect (if (zerop (gethash i (pots-data o) 0)) #\. #\#)
- :result-type 'string)))))
-(defun rune-bit (rune)
- (ecase rune
- (#\# 1)
- (#\. 0)))
-
-(defun runes-to-bits (runes)
- (map 'list #'rune-bit runes))
-
-(defun list-to-hash-table (list)
- (iterate (for value :in list)
- (for i :from 0)
- (when (plusp value)
- (collect-hash (i value) :test 'eq))))
-
-(defun surroundings-key (ll l x r rr)
- (declare (type bit ll l x r rr))
- (+ (* (expt 2 0) ll)
- (* (expt 2 1) l)
- (* (expt 2 2) x)
- (* (expt 2 3) r)
- (* (expt 2 4) rr)))
-
-(defun parse-initial-line (line)
- (ppcre:register-groups-bind
- (state)
- (#?r"initial state: (\S+)" line)
- (list-to-hash-table (runes-to-bits state))))
-
-(defun parse-rule (line)
- (ppcre:register-groups-bind
- (surroundings result)
- (#?r"(\S+) => (\S)" line)
- (values (apply #'surroundings-key (runes-to-bits surroundings))
- (rune-bit (aref result 0)))))
-
-(defun surroundings (state i)
- (let ((data (pots-data state)))
- (surroundings-key (gethash (- i 2) data 0)
- (gethash (- i 1) data 0)
- (gethash i data 0)
- (gethash (+ i 1) data 0)
- (gethash (+ i 2) data 0))))
-
-(defun tick (state rules)
- (with-slots (data min max) state
- (iterate
- (for i :from (- min 2) :to (+ max 2))
- (for current = (gethash i data 0))
- (for surroundings = (surroundings state i))
- (for next = (aref rules surroundings))
- (when (plusp next)
- (minimizing i :into next-min)
- (maximizing i :into next-max))
- (when (/= current next)
- (if (plusp next)
- (collect i :into add)
- (collect i :into rem)))
- (finally
- (dolist (i add) (setf (gethash i data) 1))
- (dolist (i rem) (remhash i data))
- (setf min next-min
- max next-max)
- state))))
-
-(define-problem (2018 12) (data)
- (let* ((initial (parse-initial-line (read-line data)))
- (state (prog1 (make-pots :data initial
- :min (extremum (hash-table-keys initial) '<)
- :max (extremum (hash-table-keys initial) '>))
- (read-line data)))
- (rules (iterate
- (with rules = (make-array (expt 2 5) :initial-element 1))
- (for line :in-stream data :using #'read-line)
- (until (string= "" line))
- (for (values key result) = (parse-rule line))
- (setf (aref rules key) result)
- (finally (return rules)))))
- (values
- (progn (do-repeat 20
- (tick state rules))
- (summation (hash-table-keys (pots-data state))))
- (progn (dotimes (i (- 500000 20))
- (when (dividesp i 1000)
- (pr i))
- (tick state rules))
- (summation (hash-table-keys (pots-data state)))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-01.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,17 @@
+(defpackage :advent/2018/01 #.cl-user::*advent-use*)
+(in-package :advent/2018/01)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2018 1) (data read-all)
+ (values
+ (summation data)
+ (progn
+ (setf (cdr (last data)) data) ; make data a circular list for easy looping
+ (iterate
+ (with seen = (make-hash-set :initial-contents '(0)))
+ (for number :in data)
+ (summing number :into frequency)
+ (if (hset-contains-p seen frequency)
+ (return frequency)
+ (hset-insert! seen frequency))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-02.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,23 @@
+(defpackage :advent/2018/02 #.cl-user::*advent-use*)
+(in-package :advent/2018/02)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2018 2) (data read-lines)
+ (values
+ (let* ((freqs (mapcar #'frequencies data))
+ (counts (mapcar #'hash-table-values freqs)))
+ (* (count 2 counts :test #'member)
+ (count 3 counts :test #'member)))
+ ;; just brute force it
+ (multiple-value-bind (a b)
+ (iterate
+ (for (a . remaining) :on data)
+ (for b = (find 1 remaining :key (curry #'hamming-distance a)))
+ (when b
+ (return (values a b))))
+ (let ((i (mismatch a b)))
+ (str:concat (subseq a 0 i)
+ (subseq a (1+ i)))))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-03.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,44 @@
+(defpackage :advent/2018/03 #.cl-user::*advent-use*)
+(in-package :advent/2018/03)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defstruct claim id left right top bottom)
+(define-with-macro claim id left right top bottom)
+
+(defun parse-claim (line)
+ (ppcre:register-groups-bind
+ ((#'parse-integer id col row width height))
+ (#?r"#(\d+) @ (\d+),(\d+): (\d+)x(\d+)" line)
+ (make-claim :id id
+ :left col
+ :top row
+ :right (+ col width)
+ :bottom (+ row height))))
+
+(defun claims-intersect-p (claim1 claim2)
+ (with-claim (claim1 id1 left1 right1 top1 bottom1)
+ (with-claim (claim2 id2 left2 right2 top2 bottom2)
+ (not (or (<= right2 left1)
+ (<= right1 left2)
+ (>= top2 bottom1)
+ (>= top1 bottom2))))))
+
+(defun make-fabric (claims)
+ (let ((fabric (make-array (list 1000 1000) :initial-element 0)))
+ (dolist (claim claims)
+ (with-claim (claim)
+ (do-range ((row top bottom)
+ (col left right))
+ (incf (aref fabric row col)))))
+ fabric))
+
+
+(define-problem (2018 3) (data read-lines)
+ (let* ((claims (mapcar #'parse-claim data))
+ (fabric (make-fabric claims)))
+ (values
+ (iterate (for uses :in-array fabric)
+ (counting (> uses 1)))
+ (claim-id (first (unique claims :test #'claims-intersect-p))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-04.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,69 @@
+(defpackage :advent/2018/04 #.cl-user::*advent-use*)
+(in-package :advent/2018/04)
+(named-readtables:in-readtable :interpol-syntax)
+
+;; This problem gets much easier after you've unlocked the second question and
+;; realize you can solve everything by building histograms of each guard's
+;; sleeping minutes.
+
+(defun parse-line (line)
+ "Parse `line` into `(minute :event id?)`"
+ (ppcre:register-groups-bind
+ ((#'parse-integer minute) event)
+ (#?r"\[\d+-\d+-\d+ \d+:(\d+)\] (.*)" line)
+ (list* minute
+ (cond
+ ((string= "falls asleep" event) (list :sleep nil))
+ ((string= "wakes up" event) (list :wake nil))
+ (t (ppcre:register-groups-bind
+ ((#'parse-integer id))
+ (#?r"Guard #(\d+) begins shift" event)
+ (list :guard id)))))))
+
+(defun sleep-intervals (events &aux start guard)
+ "Transform `events` into a list of `(guard-id start end)`"
+ (iterate
+ (for (minute event id?) :in events)
+ (ecase event
+ (:guard (setf guard id?))
+ (:wake (collect (list guard start minute)))
+ (:sleep (setf start minute)))))
+
+(defun guard-histograms (intervals)
+ "Return a hash-table of histograms of the guards' sleeping minutes."
+ (iterate
+ (with result = (make-hash-table))
+ (for (guard start end) :in intervals)
+ (for histogram = (ensure-gethash guard result
+ (make-array 60 :initial-element 0)))
+ (do-range ((minute start end))
+ (incf (aref histogram minute)))
+ (finally (return result))))
+
+
+(define-problem (2018 4) (data read-lines)
+ (let ((guard-histograms (-<> data
+ (sort <> #'string<)
+ (mapcar #'parse-line <>)
+ sleep-intervals
+ guard-histograms)))
+ (nest
+ (destructuring-bind
+ (sleepy-guard sleepy-guard-preferred-minute)
+ (iterate
+ (for (guard histogram) :in-hashtable guard-histograms)
+ (finding (list guard
+ (nth-value 1 (extremum+ histogram #'>)))
+ :maximizing (summation histogram))))
+ (destructuring-bind
+ (predictable-guard predictable-guard-time)
+ (iterate
+ (for (guard histogram) :in-hashtable guard-histograms)
+ (for (values time preferred-minute) = (extremum+ histogram #'>))
+ (finding (list guard preferred-minute) :maximizing time)))
+ (values (* sleepy-guard
+ sleepy-guard-preferred-minute)
+ (* predictable-guard
+ predictable-guard-time)))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-05.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,24 @@
+(defpackage :advent/2018/05 #.cl-user::*advent-use*)
+(in-package :advent/2018/05)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun reactivep (x y)
+ (char= x (char-invertcase y)))
+
+(defun react (string &aux result)
+ (doseq (char string)
+ (if (and result (reactivep char (car result)))
+ (pop result)
+ (push char result)))
+ (coerce (nreverse result) 'string))
+
+(define-problem (2018 5) (data alexandria:read-stream-content-into-string)
+ (deletef data #\newline)
+ (values
+ (length (react data))
+ (iterate
+ (for unit :in-vector (remove-duplicates data :test #'char-equal))
+ (for candidate = (react (remove unit data :test #'char-equal)))
+ (minimizing (length candidate)))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-06.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,45 @@
+(defpackage :advent/2018/06 #.cl-user::*advent-use*)
+(in-package :advent/2018/06)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun parse-line (line)
+ (apply #'complex (mapcar #'parse-integer (str:split ", " line))))
+
+(defun closest (point coordinates)
+ (let ((results (extremums coordinates '<
+ :key (curry #'manhattan-distance point))))
+ (case (length results)
+ (1 (car results))
+ (t nil))))
+
+(define-problem (2018 6) (data read-lines)
+ (let* ((coordinates (mapcar #'parse-line data))
+ (xs (mapcar #'realpart coordinates))
+ (ys (mapcar #'imagpart coordinates))
+ (left (extremum xs #'<))
+ (bottom (extremum ys #'<))
+ (right (extremum xs #'>))
+ (top (extremum ys #'>))
+ (counts (make-hash-table))
+ (infinite (make-hash-set)))
+ (iterate
+ (for-nested ((x :from left :to right)
+ (y :from bottom :to top)))
+ (for closest = (closest (complex x y) coordinates))
+ (when closest
+ (incf (gethash closest counts 0))
+ (when (or (= left x) (= bottom y)
+ (= right x) (= top y))
+ (hset-insert! infinite closest))))
+ (values
+ (iterate
+ (for (point size) :in-hashtable counts)
+ (unless (hset-contains-p infinite point)
+ (maximizing size)))
+ (iterate
+ (for-nested ((x :from left :to right)
+ (y :from bottom :to top)))
+ (for point = (complex x y))
+ (for total-distance = (summation coordinates :key (curry #'manhattan-distance point)))
+ (counting (< total-distance 10000))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-07.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,62 @@
+(defpackage :advent/2018/07 #.cl-user::*advent-use*)
+(in-package :advent/2018/07)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defun parse-line (line)
+ (ppcre:register-groups-bind
+ (((rcurry #'aref 0) requirement target))
+ (#?r"Step (\w) must be finished before step (\w) can begin." line)
+ (list target requirement)))
+
+(defun make-graph (edges)
+ (let* ((vertices (remove-duplicates (flatten-once edges)))
+ (graph (digraph:make-digraph :initial-vertices vertices)))
+ (dolist (edge edges)
+ (digraph:insert-edge graph (first edge) (second edge)))
+ graph))
+
+(defun char-number (char)
+ (1+ (- (char-code char) (char-code #\A))))
+
+(defun task-length (task)
+ (+ 60 (char-number task)))
+
+(defun decrement-workers (workers)
+ (gathering
+ (do-array (worker workers)
+ (when worker
+ (when (zerop (decf (cdr worker)))
+ (gather (car worker))
+ (setf worker nil))))))
+
+
+(define-problem (2018 7) (data read-lines)
+ (values
+ (let ((graph (make-graph (mapcar #'parse-line data))))
+ ;; (digraph.dot:draw graph)
+ (recursively ((result nil))
+ (if (emptyp graph)
+ (coerce (nreverse result) 'string)
+ (let ((next (extremum (digraph:leafs graph) 'char<)))
+ (digraph:remove-vertex graph next)
+ (recur (cons next result))))))
+ (iterate
+ (with graph = (make-graph (mapcar #'parse-line data)))
+ ;; workers is a vector of (task . remaining-time), or NILs for idle workers
+ (with workers = (make-array 5 :initial-element nil))
+ (for elapsed :from 0)
+ (for finished-tasks = (decrement-workers workers))
+ (map nil (curry #'digraph:remove-vertex graph) finished-tasks)
+ (for current-tasks = (remove nil (map 'list #'car workers)))
+ (for available-tasks = (-<> graph
+ digraph:leafs
+ (set-difference <> current-tasks)
+ (sort <> 'char<)))
+ (do-array (worker workers)
+ (when (null worker)
+ (when-let ((task (pop available-tasks)))
+ (setf worker (cons task (task-length task))))))
+ (when (and (emptyp graph) (every #'null workers))
+ (return elapsed)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-08.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,34 @@
+(defpackage :advent/2018/08 #.cl-user::*advent-use*)
+(in-package :advent/2018/08)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defstruct (node (:conc-name nil))
+ children metadata)
+
+(defun read-node (stream)
+ (let ((children-count (read stream))
+ (metadata-count (read stream)))
+ (make-node :children (iterate
+ (repeat children-count)
+ (collect (read-node stream) :result-type vector))
+ :metadata (iterate
+ (repeat metadata-count)
+ (collect (read stream))))))
+
+(defun node-value (node &aux (children (children node)))
+ (if (emptyp children)
+ (summation (metadata node))
+ (iterate
+ (for meta :in (metadata node))
+ (for index = (1- meta))
+ (when (array-in-bounds-p children index)
+ (summing (node-value (aref children index)))))))
+
+(define-problem (2018 8) (data)
+ (let ((root (read-node data)))
+ (values
+ (recursively ((node root))
+ (+ (summation (metadata node))
+ (summation (children node) :key #'recur)))
+ (node-value root))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-09.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,34 @@
+(defpackage :advent/2018/09 #.cl-user::*advent-use*)
+(in-package :advent/2018/09)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defun parse-input (line)
+ (ppcre:register-groups-bind
+ ((#'parse-integer players marbles))
+ (#?r"(\d+) players\D*(\d+) points" line)
+ (values players marbles)))
+
+(defun play (players marbles)
+ (let ((circle (ring 0))
+ (elves (make-array players :initial-element 0)))
+ (iterate
+ (declare (iterate:declare-variables))
+ (for elf :first 0 :then (mod (1+ elf) players))
+ (for marble :from 1 :to marbles)
+ (if (dividesp marble 23)
+ (progn (incf (aref elves elf) marble)
+ (ring-movef circle -7)
+ (incf (aref elves elf) (ring-data circle))
+ (ring-cutf circle))
+ (progn (ring-movef circle 1)
+ (ring-insertf-after circle marble))))
+ (extremum elves '>)))
+
+
+(define-problem (2018 9) (data alexandria:read-stream-content-into-string)
+ (multiple-value-bind (players marbles) (parse-input data)
+ #+sbcl (sb-ext:gc :full t)
+ (values (play players marbles)
+ (play players (* marbles 100)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-10.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,56 @@
+(defpackage :advent/2018/10 #.cl-user::*advent-use*)
+(in-package :advent/2018/10)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun parse-line (line)
+ (destructuring-bind (x y vx vy) line
+ (cons (complex x y)
+ (complex vx vy))))
+
+(defun x (star)
+ (realpart (car star)))
+
+(defun y (star)
+ (imagpart (car star)))
+
+(defun tick (stars)
+ (dolist (star stars)
+ (incf (car star) (cdr star))))
+
+(defun bounds (stars)
+ (values (x (extremum stars '< :key #'x)) ; left
+ (x (extremum stars '> :key #'x)) ; right
+ (y (extremum stars '< :key #'y)) ; bottom
+ (y (extremum stars '> :key #'y)))) ; top
+
+(defun field-size (stars)
+ (multiple-value-bind (left right bottom top)
+ (bounds stars)
+ (* (- right left) (- top bottom))))
+
+(defun draw (stars)
+ (multiple-value-bind (left right bottom top) (bounds stars)
+ (let* ((height (1+ (- top bottom)))
+ (width (1+ (- right left)))
+ (field (make-array height)))
+ (do-array (line field)
+ (setf line (make-string width :initial-element #\space)))
+ (dolist (star stars)
+ (setf (aref (aref field (- (y star) bottom))
+ (- (x star) left))
+ #\*))
+ (map nil #'write-line field))))
+
+(define-problem (2018 10) (data read-lines-of-numbers-and-garbage)
+ (iterate
+ (with stars = (mapcar #'parse-line data))
+ (with ticks = 0)
+ (initially (iterate
+ (tick stars)
+ (incf ticks)
+ (until (< (field-size stars) 3000))))
+ (format t "After tick ~D:~%" ticks)
+ (draw stars)
+ (until (string= "q" (read-line)))
+ (tick stars)))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-11.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,59 @@
+(defpackage :advent/2018/11 #.cl-user::*advent-use*)
+(in-package :advent/2018/11)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun cell (x y)
+ (complex x y))
+
+(defun x (cell)
+ (realpart cell))
+
+(defun y (cell)
+ (imagpart cell))
+
+(defun rack-id (cell)
+ (+ (x cell) 10))
+
+(defun power-level (serial-number cell)
+ (-<> (rack-id cell)
+ (* <> (y cell))
+ (+ <> serial-number)
+ (* <> (rack-id cell))
+ (nth-digit 2 <>)
+ (- <> 5)))
+
+(define-problem (2018 11) (serial-number read)
+ (let ((totals (make-array (list 300 300))))
+ (flet ((gref (x y)
+ (let ((x (1- x))
+ (y (1- y)))
+ (if (array-in-bounds-p totals x y)
+ (aref totals x y)
+ 0)))
+ ((setf gref) (value x y)
+ (setf (aref totals (1- x) (1- y)) value)))
+ (iterate (for-nested ((x :from 300 :downto 1)
+ (y :from 300 :downto 1)))
+ (setf (gref x y)
+ (+ (power-level serial-number (cell x y))
+ (gref (1+ x) y)
+ (gref x (1+ y))
+ (- (gref (1+ x) (1+ y))))))
+ (labels ((square-power (x y n)
+ (let ((xn (+ x n))
+ (yn (+ y n)))
+ (+ (gref x y)
+ (- (gref xn y))
+ (- (gref x yn))
+ (gref xn yn))))
+ (largest-square (n)
+ (iterate
+ (for-nested ((x :from 1 :to (- 301 n))
+ (y :from 1 :to (- 301 n))))
+ (for power = (square-power x y n))
+ (finding (list x y power) :maximizing power))))
+ (values (subseq (largest-square 3) 0 2)
+ (iterate (for n :from 1 :to 300)
+ (for (x y power) = (largest-square n))
+ (finding (list x y n) :maximizing power)))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/day-12.lisp Sun Dec 16 18:11:25 2018 -0500
@@ -0,0 +1,99 @@
+(defpackage :advent/2018/12 #.cl-user::*advent-use*)
+(in-package :advent/2018/12)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(defstruct pots data min max)
+
+(defmethod print-object ((o pots) s)
+ (print-unreadable-object (o s :type t)
+ (format s "~D to ~D: ~A" (pots-min o) (pots-max o)
+ (iterate (for i :from (pots-min o) :to (pots-max o))
+ (collect (if (zerop (gethash i (pots-data o) 0)) #\. #\#)
+ :result-type 'string)))))
+(defun rune-bit (rune)
+ (ecase rune
+ (#\# 1)
+ (#\. 0)))
+
+(defun runes-to-bits (runes)
+ (map 'list #'rune-bit runes))
+
+(defun list-to-hash-table (list)
+ (iterate (for value :in list)
+ (for i :from 0)
+ (when (plusp value)
+ (collect-hash (i value) :test 'eq))))
+
+(defun surroundings-key (ll l x r rr)
+ (declare (type bit ll l x r rr))
+ (+ (* (expt 2 0) ll)
+ (* (expt 2 1) l)
+ (* (expt 2 2) x)
+ (* (expt 2 3) r)
+ (* (expt 2 4) rr)))
+
+(defun parse-initial-line (line)
+ (ppcre:register-groups-bind
+ (state)
+ (#?r"initial state: (\S+)" line)
+ (list-to-hash-table (runes-to-bits state))))
+
+(defun parse-rule (line)
+ (ppcre:register-groups-bind
+ (surroundings result)
+ (#?r"(\S+) => (\S)" line)
+ (values (apply #'surroundings-key (runes-to-bits surroundings))
+ (rune-bit (aref result 0)))))
+
+(defun surroundings (state i)
+ (let ((data (pots-data state)))
+ (surroundings-key (gethash (- i 2) data 0)
+ (gethash (- i 1) data 0)
+ (gethash i data 0)
+ (gethash (+ i 1) data 0)
+ (gethash (+ i 2) data 0))))
+
+(defun tick (state rules)
+ (with-slots (data min max) state
+ (iterate
+ (for i :from (- min 2) :to (+ max 2))
+ (for current = (gethash i data 0))
+ (for surroundings = (surroundings state i))
+ (for next = (aref rules surroundings))
+ (when (plusp next)
+ (minimizing i :into next-min)
+ (maximizing i :into next-max))
+ (when (/= current next)
+ (if (plusp next)
+ (collect i :into add)
+ (collect i :into rem)))
+ (finally
+ (dolist (i add) (setf (gethash i data) 1))
+ (dolist (i rem) (remhash i data))
+ (setf min next-min
+ max next-max)
+ state))))
+
+(define-problem (2018 12) (data)
+ (let* ((initial (parse-initial-line (read-line data)))
+ (state (prog1 (make-pots :data initial
+ :min (extremum (hash-table-keys initial) '<)
+ :max (extremum (hash-table-keys initial) '>))
+ (read-line data)))
+ (rules (iterate
+ (with rules = (make-array (expt 2 5) :initial-element 1))
+ (for line :in-stream data :using #'read-line)
+ (until (string= "" line))
+ (for (values key result) = (parse-rule line))
+ (setf (aref rules key) result)
+ (finally (return rules)))))
+ (values
+ (progn (do-repeat 20
+ (tick state rules))
+ (summation (hash-table-keys (pots-data state))))
+ (progn (dotimes (i (- 500000 20))
+ (when (dividesp i 1000)
+ (pr i))
+ (tick state rules))
+ (summation (hash-table-keys (pots-data state)))))))