--- a/advent.asd Thu Dec 05 19:36:23 2019 -0500
+++ b/advent.asd Thu Dec 05 20:45:46 2019 -0500
@@ -41,7 +41,12 @@
(:file "package")
(:module "src" :serial t
:components ((:file "utils")
- (:file "number-spiral")
- (:file "intcode")
- (:auto-module "2018")
- (:auto-module "2019")))))
+ (:module "2017" :serial t
+ :components ((:file "number-spiral")
+ (:file "knot-hash")
+ (:auto-module "days")))
+ (:module "2018" :serial t
+ :components ((:auto-module "days")))
+ (:module "2019" :serial t
+ :components ((:file "intcode")
+ (:auto-module "days")))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/data/2017/14.txt Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,1 @@
+wenycdww
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/data/2017/15.txt Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,2 @@
+Generator A starts with 783
+Generator B starts with 325
--- a/package.lisp Thu Dec 05 19:36:23 2019 -0500
+++ b/package.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -34,6 +34,7 @@
:digits
:fresh-vector
:let-result
+ :let-complex
:ring
:ring-prev
--- a/src/2017/day-01.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-(defpackage :advent/2017/01 #.cl-user::*advent-use*)
-(in-package :advent/2017/01)
-
-
-(define-problem (2017 1) (data read-line) (1049 1508)
- (iterate
- (with digits = (map 'vector #'digit-char-p data))
- (for digit :in-vector digits)
- (for prev :previous digit :initially (aref digits (1- (length digits))))
- (for j :modulo (length digits) :from (truncate (length digits) 2))
- (for next = (aref digits j))
- (when (= digit prev) (sum digit :into part1))
- (when (= digit next) (sum digit :into part2))
- (finally (return (values part1 part2)))))
-
--- a/src/2017/day-02.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-(defpackage :advent/2017/02 #.cl-user::*advent-use*)
-(in-package :advent/2017/02)
-
-(defun find-quotient (row)
- (alexandria:map-permutations
- (lambda (pair)
- (multiple-value-bind (quotient remainder)
- (truncate (first pair) (second pair))
- (when (zerop remainder)
- (return-from find-quotient quotient))))
- row :length 2 :copy nil))
-
-(defun checksum (row)
- (multiple-value-bind (lo hi) (extrema #'< row)
- (- hi lo)))
-
-(define-problem (2017 2) (data read-lines-of-numbers-and-garbage) (53460 282)
- (iterate
- (for row :in data)
- (summing (checksum row) :into part1)
- (summing (find-quotient row) :into part2)
- (finally (return (values part1 part2)))))
-
--- a/src/2017/day-03.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-(defpackage :advent/2017/03 #.cl-user::*advent-use*)
-(in-package :advent/2017/03)
-
-(defmacro let-complex (bindings &body body)
- `(let* (,@(iterate (for (x y val) :in bindings)
- (for v = (gensym))
- (collect `(,v ,val))
- (collect `(,x (realpart ,v)))
- (collect `(,y (imagpart ,v)))))
- ,@body))
-
-(defun manhattan-distance (a b)
- (let-complex ((ax ay a)
- (bx by b))
- (+ (abs (- ax bx))
- (abs (- ay by)))))
-
-(defun neighbors (coord)
- (iterate (for (dx dy) :within-radius 1 :skip-origin t)
- (collect (+ coord (complex dx dy)))))
-
-(define-problem (2017 3) (data read) (552 330785)
- (values
- (manhattan-distance #c(0 0) (advent/spiral:number-coordinates data))
- (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 data))
- (setf (gethash coord memory) value))))
-
-
--- a/src/2017/day-04.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,40 +0,0 @@
-(defpackage :advent/2017/04 #.cl-user::*advent-use*)
-(in-package :advent/2017/04)
-
-(defun valid-hash-table-test-p (test)
- (member test `(eq eql equal equalp ,#'eq ,#'eql ,#'equal ,#'equalp)))
-
-(defun ensure-boolean (value)
- (if value t nil))
-
-(defun contains-duplicates-p (sequence &key (test #'eql))
- (ensure-boolean (if (valid-hash-table-test-p test)
- (iterate
- (with seen = (make-hash-set :test test))
- (for value :in-whatever sequence)
- (thereis (hset-contains-p seen value))
- (hset-insert! seen value))
- (etypecase sequence
- (list (iterate
- (for (value . remaining) :on sequence)
- (thereis (position value remaining :test test))))
- (sequence
- (iterate
- (for i :from 0 :below (length sequence))
- (for value = (elt sequence i))
- (thereis (position value sequence :start (1+ i) :test test))))))))
-
-
-(defun anagramp (string1 string2)
- (string= (sort (copy-seq string1) #'char<)
- (sort (copy-seq string2) #'char<)))
-
-(define-problem (2017 4) (data read-lines-of-words) (337 231)
- (values (count-if (lambda (phrase)
- (not (contains-duplicates-p phrase :test #'equal)))
- data)
- (count-if (lambda (phrase)
- (not (contains-duplicates-p phrase :test #'anagramp)))
- data)))
-
-
--- a/src/2017/day-05.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-(defpackage :advent/2017/05 #.cl-user::*advent-use*)
-(in-package :advent/2017/05)
-
-(defun compute (data modification-function)
- (iterate
- (with maze = (fresh-vector data))
- (with bound = (1- (length maze)))
- (with address = 0)
- (while (<= 0 address bound))
- (counting t)
- (for offset = (aref maze address))
- (callf (aref maze address) modification-function)
- (incf address offset)))
-
-(define-problem (2017 5) (data read-all) (342669 25136209)
- (values
- (compute data #'1+)
- (compute data (lambda (value) (+ value (if (>= value 3) -1 1))))))
-
-
--- a/src/2017/day-06.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,29 +0,0 @@
-(defpackage :advent/2017/06 #.cl-user::*advent-use*)
-(in-package :advent/2017/06)
-
-
-(define-problem (2017 6) (data read-all) (6681 2392)
- (let ((banks (coerce data 'vector))
- (seen (make-hash-table :test 'equalp)))
- (labels ((bank-to-redistribute ()
- (iterate (for blocks :in-vector banks :with-index bank)
- (finding bank :maximizing blocks)))
- (redistribute ()
- (iterate
- (with bank = (bank-to-redistribute))
- (with blocks-to-redistribute = (aref banks bank))
- (initially (setf (aref banks bank) 0))
- (repeat blocks-to-redistribute)
- (for b :modulo (length banks) :from (1+ bank))
- (incf (aref banks b))))
- (mark-seen (banks cycles)
- (setf (gethash (copy-seq banks) seen) cycles)))
- (iterate
- (mark-seen banks cycle)
- (counting t :into cycle)
- (redistribute)
- (for last-seen = (gethash banks seen))
- (until last-seen)
- (finally (return (values cycle (- cycle last-seen))))))))
-
-
--- a/src/2017/day-07.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,74 +0,0 @@
-(defpackage :advent/2017/07 #.cl-user::*advent-use*)
-(in-package :advent/2017/07)
-(named-readtables:in-readtable :interpol-syntax)
-
-(defun parse-line (line)
- (ppcre:register-groups-bind
- (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
- (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
- (values name weight holding)))
-
-(defun insert-edge (digraph pred succ)
- (digraph:insert-vertex digraph pred)
- (digraph:insert-vertex digraph succ)
- (digraph:insert-edge digraph pred succ))
-
-(defun build-tower (lines)
- (iterate
- (with tower = (digraph:make-digraph :test #'equal))
- (for line :in lines)
- (for (values name weight holding) = (parse-line line))
- (collect-hash (name weight) :into weights :test #'equal)
- (digraph:insert-vertex tower name)
- (map nil (curry #'insert-edge tower name) holding)
- (finally (return (values tower weights)))))
-
-(defun root (digraph)
- (first (digraph:roots digraph)))
-
-(defun compute-total-weights (digraph individual-weights)
- (let ((result (make-hash-table :test #'equal)))
- (recursively ((node (root digraph)))
- (setf (gethash node result)
- (+ (gethash node individual-weights)
- (loop :for succ :in (digraph:successors digraph node)
- :summing (recur succ)))))
- result))
-
-(defun find-proper-weight (digraph total-weights)
- (labels
- ((unbalanced-child (node)
- (iterate
- (with weights = (make-hash-table))
- (for child :in (digraph:successors digraph node))
- (for weight = (gethash child total-weights))
- (push child (gethash weight weights))
- (finally
- (return
- (if (<= (hash-table-count weights) 1)
- nil
- (values
- (iterate
- (for (w children) :in-hashtable weights)
- (finding (first children) :such-that (= 1 (length children))))
- (iterate
- (for (w children) :in-hashtable weights)
- (finding w :such-that (> (length children) 1))))))))))
- (recursively ((node (root digraph))
- (target 0))
- (multiple-value-bind (child new-target) (unbalanced-child node)
- (if (null child)
- (values node target)
- (recur child new-target))))))
-
-(define-problem (2017 7) (data read-lines) ("bsfpjtc" 529)
- (multiple-value-bind (tower individual-weights) (build-tower data)
- ;; (digraph.dot:draw tower)
- (values
- (root tower)
- (let ((total-weights (compute-total-weights tower individual-weights)))
- (multiple-value-bind (node target-weight)
- (find-proper-weight tower total-weights)
- ;; fuck this miserable problem, I just want to be done
- (+ (gethash node individual-weights)
- (- target-weight (gethash node total-weights))))))))
--- a/src/2017/day-08.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-(defpackage :advent/2017/08 #.cl-user::*advent-use*)
-(in-package :advent/2017/08)
-
-(defun == (x y) (= x y))
-(defun != (x y) (/= x y))
-
-(defun inc (delta) delta)
-(defun dec (delta) (- delta))
-
-(define-problem (2017 8) (data read-lines) (5215 6419)
- (let ((registers (make-hash-table)))
- (macrolet ((r (register) `(gethash ,register registers 0)))
- (iterate
- (for line :in data)
- (for (reg op delta nil cmp-reg cmp-op cmp-bound) := (read-all-from-string line))
- (when (funcall cmp-op (r cmp-reg) cmp-bound)
- (maximizing (incf (r reg) (funcall op delta)) :into highest))
- (finally (return (values (alexandria:extremum (alexandria:hash-table-values registers) #'>) highest)))))))
--- a/src/2017/day-09.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-(defpackage :advent/2017/09 #.cl-user::*advent-use*)
-(in-package :advent/2017/09)
-
-(define-problem (2017 9) (stream) (15922 7314)
- (let ((garbage-total 0))
- (labels ((read-garbage-char ()
- (if (eql #\! (peek-char nil stream))
- (progn (read-char stream)
- (read-char stream))
- (progn (incf garbage-total)
- (read-char stream))))
- (read-garbage ()
- (read-char stream) ; <
- (iterate
- (until (eql #\> (peek-char nil stream)))
- (read-garbage-char))
- (read-char stream) ; >
- 'garbage)
- (read-group ()
- (read-char stream) ; {
- (prog1 (read-group-contents)
- (read-char stream))) ; }
- (read-group-contents (&aux result)
- (iterate
- (case (peek-char nil stream)
- (#\, (read-char stream))
- (#\} (return (nreverse result)))
- (#\{ (push (read-group) result))
- (#\< (read-garbage))))))
- (values
- (recursively ((group (read-group))
- (score 1))
- (+ score (loop :for g :in group :summing (recur g (1+ score)))))
- garbage-total))))
-
--- a/src/2017/day-10.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,52 +0,0 @@
-(defpackage :advent/2017/10 #.cl-user::*advent-use*)
-(in-package :advent/2017/10)
-
-(defun reverse-chunk (vector start length)
- (iterate
- (repeat (truncate length 2))
- (for i :modulo (length vector) :from start)
- (for j :modulo (length vector) :downfrom (+ start (1- length)))
- (rotatef (aref vector i) (aref vector j))))
-
-(defun simple-knot-hash (lengths)
- (iterate
- (with numbers = (coerce (alexandria:iota 256) 'vector))
- (with current = 0)
- (with skip = 0)
- (for length :in lengths)
- (reverse-chunk numbers current length)
- (zapf current (mod (+ % length skip) 256))
- (incf skip)
- (finally (return (* (aref numbers 0) (aref numbers 1))))))
-
-(defun sparse->dense (numbers)
- (iterate
- (for i :from 0 :by 16 :below (length numbers))
- (collect (reduce #'logxor numbers :start i :end (+ i 16)))))
-
-(defun bytes->hex (bytes)
- (format nil "~(~{~2,'0X~}~)" bytes))
-
-(defun initial-lengths (string)
- (append (map 'list #'char-code string)
- (list 17 31 73 47 23)))
-
-(defun full-knot-hash (string)
- (iterate
- (with lengths = (initial-lengths string))
- (with numbers = (coerce (alexandria:iota 256) 'vector))
- (with current = 0)
- (with skip = 0)
- (repeat 64)
- (iterate
- (for length :in lengths)
- (reverse-chunk numbers current length)
- (zapf current (mod (+ % length skip) 256))
- (incf skip))
- (finally (return (bytes->hex (sparse->dense numbers))))))
-
-(define-problem (2017 10) (data alexandria:read-stream-content-into-string) ()
- (values
- (simple-knot-hash (read-numbers-from-string data))
- (full-knot-hash (str:trim data))))
-
--- a/src/2017/day-11.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-(defpackage :advent/2017/11 #.cl-user::*advent-use*)
-(in-package :advent/2017/11)
-
-;; https://www.redblobgames.com/grids/hexagons/#coordinates
-
-(defun coord+ (c1 c2)
- (map 'vector #'+ c1 c2))
-
-(defun coord- (c1 c2)
- (map 'vector #'- c1 c2))
-
-(defun distance (c1 &optional (c2 #(0 0 0)))
- (/ (reduce #'+ (coord- c1 c2) :key #'abs) 2))
-
-(define-problem (2017 11) (data read-comma-separated-values) (773 1560)
- (iterate
- (with pos = #(0 0 0))
- (for direction :in (mapcar #'ensure-keyword data))
- (setf pos (coord+ pos (delta direction)))
- (maximizing (distance pos) :into furthest)
- (finally (return (values (distance pos) furthest)))))
--- a/src/2017/day-12.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,36 +0,0 @@
-(defpackage :advent/2017/12 #.cl-user::*advent-use*)
-(in-package :advent/2017/12)
-
-(defun parse-line (line)
- (destructuring-bind (id others) (str:split "<->" line)
- (list (parse-integer id)
- (mapcar #'parse-integer (str:split #\, others)))))
-
-(defun build-graph (records)
- (iterate
- (with graph = (digraph:make-digraph :initial-vertices (mapcar #'car records)))
- (for (id others) :in records)
- (dolist (id2 others)
- (digraph:insert-edge graph id id2))
- (finally (return graph))))
-
-(defun connected-to (graph start)
- (gathering
- (digraph:mapc-depth-first #'gather graph start)))
-
-(defun count-subgraph (graph start)
- (length (connected-to graph start)))
-
-(defun remove-subgraph (graph start)
- (map nil (alexandria:curry #'digraph:remove-vertex graph)
- (connected-to graph start)))
-
-(define-problem (2017 12) (data read-lines) (141 171)
- (let ((graph (build-graph (mapcar #'parse-line data))))
- (values
- (count-subgraph graph 0)
- (iterate
- (for vertex = (digraph:arbitrary-vertex graph))
- (while vertex)
- (remove-subgraph graph vertex)
- (counting t)))))
--- a/src/2017/day-13.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,68 +0,0 @@
-(defpackage :advent/2017/13 #.cl-user::*advent-use*)
-(in-package :advent/2017/13)
-
-;; There's a magical insight that you need to get if you want to do this
-;; problem: the length of a scanner of range R is `2(R-1)`.
-;;
-;; Examples:
-;;
-;; R = 2: S. 1
-;; .S 2 = 2(R-1) = 2(2-1) = 2(1) = 2
-;;
-;; R = 3: S.. 1
-;; .S. 2
-;; ..S 3
-;; .S. 4 = 2(R-1) = 2(3-1) = 2(2) = 4
-;;
-;; R = 4: S... 1
-;; .S.. 2
-;; ..S. 3
-;; ...S 4
-;; ..S. 5
-;; .S.. 6 = 2(R-1) = 2(4-1) = 2(3) = 6
-;;
-;; The best "intuition" I can come up with for this is:
-;;
-;; * We spend 1 turn at each end position.
-;; * We spend 2 turns at each inner position.
-;; * We have R positions, 2 of which are an end and (R-2) of which are inner.
-;; * So we have (2 * 1) + ((R-2) * 2) = 2 + 2(R-2) turns.
-;; * Factor out the 2 and simplify: 2(1 + (R-2)) = 2(R-1).
-;;
-;; Figuring out the exact position of a scanner at a given time it tricky
-;; because you need to wrap the position around properly during the second half,
-;; but we can skip that because all we care about is whether it's at zero.
-
-(defun catchesp (range time)
- (zerop (mod time (* (1- range) 2))))
-
-(defun make-scanners (specs)
- (iterate
- (with scanners = (make-array (1+ (caar (last specs))) :initial-element nil))
- (for (level range) :in specs)
- (setf (aref scanners level) range)
- (finally (return scanners))))
-
-(defun severity (level range)
- (* level range))
-
-(defun traverse (scanners start-time)
- (iterate
- (for level :from 0)
- (for time :from start-time)
- (for range :in-vector scanners)
- (for caught = (and range (catchesp range time)))
- (oring caught :into ever-caught)
- (when caught
- (summing (severity level range) :into score))
- (returning score ever-caught)))
-
-(define-problem (2017 13) (data read-lines-of-numbers-and-garbage)
- (2604 3941460)
- (let ((scanners (make-scanners data)))
- (values
- (traverse scanners 0)
- (iterate
- (for delay :from 0)
- (for (values score caught) = (traverse scanners delay))
- (finding delay :such-that (not caught))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-01.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,15 @@
+(defpackage :advent/2017/01 #.cl-user::*advent-use*)
+(in-package :advent/2017/01)
+
+
+(define-problem (2017 1) (data read-line) (1049 1508)
+ (iterate
+ (with digits = (map 'vector #'digit-char-p data))
+ (for digit :in-vector digits)
+ (for prev :previous digit :initially (aref digits (1- (length digits))))
+ (for j :modulo (length digits) :from (truncate (length digits) 2))
+ (for next = (aref digits j))
+ (when (= digit prev) (sum digit :into part1))
+ (when (= digit next) (sum digit :into part2))
+ (finally (return (values part1 part2)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-02.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,23 @@
+(defpackage :advent/2017/02 #.cl-user::*advent-use*)
+(in-package :advent/2017/02)
+
+(defun find-quotient (row)
+ (alexandria:map-permutations
+ (lambda (pair)
+ (multiple-value-bind (quotient remainder)
+ (truncate (first pair) (second pair))
+ (when (zerop remainder)
+ (return-from find-quotient quotient))))
+ row :length 2 :copy nil))
+
+(defun checksum (row)
+ (multiple-value-bind (lo hi) (extrema #'< row)
+ (- hi lo)))
+
+(define-problem (2017 2) (data read-lines-of-numbers-and-garbage) (53460 282)
+ (iterate
+ (for row :in data)
+ (summing (checksum row) :into part1)
+ (summing (find-quotient row) :into part2)
+ (finally (return (values part1 part2)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-03.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,27 @@
+(defpackage :advent/2017/03 #.cl-user::*advent-use*)
+(in-package :advent/2017/03)
+
+
+(defun manhattan-distance (a b)
+ (let-complex ((ax ay a)
+ (bx by b))
+ (+ (abs (- ax bx))
+ (abs (- ay by)))))
+
+(defun neighbors (coord)
+ (iterate (for (dx dy) :within-radius 1 :skip-origin t)
+ (collect (+ coord (complex dx dy)))))
+
+(define-problem (2017 3) (data read) (552 330785)
+ (values
+ (manhattan-distance #c(0 0) (advent/spiral:number-coordinates data))
+ (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 data))
+ (setf (gethash coord memory) value))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-04.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,40 @@
+(defpackage :advent/2017/04 #.cl-user::*advent-use*)
+(in-package :advent/2017/04)
+
+(defun valid-hash-table-test-p (test)
+ (member test `(eq eql equal equalp ,#'eq ,#'eql ,#'equal ,#'equalp)))
+
+(defun ensure-boolean (value)
+ (if value t nil))
+
+(defun contains-duplicates-p (sequence &key (test #'eql))
+ (ensure-boolean (if (valid-hash-table-test-p test)
+ (iterate
+ (with seen = (make-hash-set :test test))
+ (for value :in-whatever sequence)
+ (thereis (hset-contains-p seen value))
+ (hset-insert! seen value))
+ (etypecase sequence
+ (list (iterate
+ (for (value . remaining) :on sequence)
+ (thereis (position value remaining :test test))))
+ (sequence
+ (iterate
+ (for i :from 0 :below (length sequence))
+ (for value = (elt sequence i))
+ (thereis (position value sequence :start (1+ i) :test test))))))))
+
+
+(defun anagramp (string1 string2)
+ (string= (sort (copy-seq string1) #'char<)
+ (sort (copy-seq string2) #'char<)))
+
+(define-problem (2017 4) (data read-lines-of-words) (337 231)
+ (values (count-if (lambda (phrase)
+ (not (contains-duplicates-p phrase :test #'equal)))
+ data)
+ (count-if (lambda (phrase)
+ (not (contains-duplicates-p phrase :test #'anagramp)))
+ data)))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-05.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,20 @@
+(defpackage :advent/2017/05 #.cl-user::*advent-use*)
+(in-package :advent/2017/05)
+
+(defun compute (data modification-function)
+ (iterate
+ (with maze = (fresh-vector data))
+ (with bound = (1- (length maze)))
+ (with address = 0)
+ (while (<= 0 address bound))
+ (counting t)
+ (for offset = (aref maze address))
+ (callf (aref maze address) modification-function)
+ (incf address offset)))
+
+(define-problem (2017 5) (data read-all) (342669 25136209)
+ (values
+ (compute data #'1+)
+ (compute data (lambda (value) (+ value (if (>= value 3) -1 1))))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-06.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,29 @@
+(defpackage :advent/2017/06 #.cl-user::*advent-use*)
+(in-package :advent/2017/06)
+
+
+(define-problem (2017 6) (data read-all) (6681 2392)
+ (let ((banks (coerce data 'vector))
+ (seen (make-hash-table :test 'equalp)))
+ (labels ((bank-to-redistribute ()
+ (iterate (for blocks :in-vector banks :with-index bank)
+ (finding bank :maximizing blocks)))
+ (redistribute ()
+ (iterate
+ (with bank = (bank-to-redistribute))
+ (with blocks-to-redistribute = (aref banks bank))
+ (initially (setf (aref banks bank) 0))
+ (repeat blocks-to-redistribute)
+ (for b :modulo (length banks) :from (1+ bank))
+ (incf (aref banks b))))
+ (mark-seen (banks cycles)
+ (setf (gethash (copy-seq banks) seen) cycles)))
+ (iterate
+ (mark-seen banks cycle)
+ (counting t :into cycle)
+ (redistribute)
+ (for last-seen = (gethash banks seen))
+ (until last-seen)
+ (finally (return (values cycle (- cycle last-seen))))))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-07.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,74 @@
+(defpackage :advent/2017/07 #.cl-user::*advent-use*)
+(in-package :advent/2017/07)
+(named-readtables:in-readtable :interpol-syntax)
+
+(defun parse-line (line)
+ (ppcre:register-groups-bind
+ (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
+ (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
+ (values name weight holding)))
+
+(defun insert-edge (digraph pred succ)
+ (digraph:insert-vertex digraph pred)
+ (digraph:insert-vertex digraph succ)
+ (digraph:insert-edge digraph pred succ))
+
+(defun build-tower (lines)
+ (iterate
+ (with tower = (digraph:make-digraph :test #'equal))
+ (for line :in lines)
+ (for (values name weight holding) = (parse-line line))
+ (collect-hash (name weight) :into weights :test #'equal)
+ (digraph:insert-vertex tower name)
+ (map nil (curry #'insert-edge tower name) holding)
+ (finally (return (values tower weights)))))
+
+(defun root (digraph)
+ (first (digraph:roots digraph)))
+
+(defun compute-total-weights (digraph individual-weights)
+ (let ((result (make-hash-table :test #'equal)))
+ (recursively ((node (root digraph)))
+ (setf (gethash node result)
+ (+ (gethash node individual-weights)
+ (loop :for succ :in (digraph:successors digraph node)
+ :summing (recur succ)))))
+ result))
+
+(defun find-proper-weight (digraph total-weights)
+ (labels
+ ((unbalanced-child (node)
+ (iterate
+ (with weights = (make-hash-table))
+ (for child :in (digraph:successors digraph node))
+ (for weight = (gethash child total-weights))
+ (push child (gethash weight weights))
+ (finally
+ (return
+ (if (<= (hash-table-count weights) 1)
+ nil
+ (values
+ (iterate
+ (for (w children) :in-hashtable weights)
+ (finding (first children) :such-that (= 1 (length children))))
+ (iterate
+ (for (w children) :in-hashtable weights)
+ (finding w :such-that (> (length children) 1))))))))))
+ (recursively ((node (root digraph))
+ (target 0))
+ (multiple-value-bind (child new-target) (unbalanced-child node)
+ (if (null child)
+ (values node target)
+ (recur child new-target))))))
+
+(define-problem (2017 7) (data read-lines) ("bsfpjtc" 529)
+ (multiple-value-bind (tower individual-weights) (build-tower data)
+ ;; (digraph.dot:draw tower)
+ (values
+ (root tower)
+ (let ((total-weights (compute-total-weights tower individual-weights)))
+ (multiple-value-bind (node target-weight)
+ (find-proper-weight tower total-weights)
+ ;; fuck this miserable problem, I just want to be done
+ (+ (gethash node individual-weights)
+ (- target-weight (gethash node total-weights))))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-08.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,18 @@
+(defpackage :advent/2017/08 #.cl-user::*advent-use*)
+(in-package :advent/2017/08)
+
+(defun == (x y) (= x y))
+(defun != (x y) (/= x y))
+
+(defun inc (delta) delta)
+(defun dec (delta) (- delta))
+
+(define-problem (2017 8) (data read-lines) (5215 6419)
+ (let ((registers (make-hash-table)))
+ (macrolet ((r (register) `(gethash ,register registers 0)))
+ (iterate
+ (for line :in data)
+ (for (reg op delta nil cmp-reg cmp-op cmp-bound) := (read-all-from-string line))
+ (when (funcall cmp-op (r cmp-reg) cmp-bound)
+ (maximizing (incf (r reg) (funcall op delta)) :into highest))
+ (finally (return (values (alexandria:extremum (alexandria:hash-table-values registers) #'>) highest)))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-09.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,35 @@
+(defpackage :advent/2017/09 #.cl-user::*advent-use*)
+(in-package :advent/2017/09)
+
+(define-problem (2017 9) (stream) (15922 7314)
+ (let ((garbage-total 0))
+ (labels ((read-garbage-char ()
+ (if (eql #\! (peek-char nil stream))
+ (progn (read-char stream)
+ (read-char stream))
+ (progn (incf garbage-total)
+ (read-char stream))))
+ (read-garbage ()
+ (read-char stream) ; <
+ (iterate
+ (until (eql #\> (peek-char nil stream)))
+ (read-garbage-char))
+ (read-char stream) ; >
+ 'garbage)
+ (read-group ()
+ (read-char stream) ; {
+ (prog1 (read-group-contents)
+ (read-char stream))) ; }
+ (read-group-contents (&aux result)
+ (iterate
+ (case (peek-char nil stream)
+ (#\, (read-char stream))
+ (#\} (return (nreverse result)))
+ (#\{ (push (read-group) result))
+ (#\< (read-garbage))))))
+ (values
+ (recursively ((group (read-group))
+ (score 1))
+ (+ score (loop :for g :in group :summing (recur g (1+ score)))))
+ garbage-total))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-10.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,9 @@
+(defpackage :advent/2017/10 #.cl-user::*advent-use*)
+(in-package :advent/2017/10)
+
+(define-problem (2017 10) (data alexandria:read-stream-content-into-string)
+ (19591 "62e2204d2ca4f4924f6e7a80f1288786")
+ (values
+ (advent/knot-hash:simple-knot-hash (read-numbers-from-string data))
+ (advent/knot-hash:full-knot-hash (str:trim data))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-11.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,21 @@
+(defpackage :advent/2017/11 #.cl-user::*advent-use*)
+(in-package :advent/2017/11)
+
+;; https://www.redblobgames.com/grids/hexagons/#coordinates
+
+(defun coord+ (c1 c2)
+ (map 'vector #'+ c1 c2))
+
+(defun coord- (c1 c2)
+ (map 'vector #'- c1 c2))
+
+(defun distance (c1 &optional (c2 #(0 0 0)))
+ (/ (reduce #'+ (coord- c1 c2) :key #'abs) 2))
+
+(define-problem (2017 11) (data read-comma-separated-values) (773 1560)
+ (iterate
+ (with pos = #(0 0 0))
+ (for direction :in (mapcar #'ensure-keyword data))
+ (setf pos (coord+ pos (delta direction)))
+ (maximizing (distance pos) :into furthest)
+ (finally (return (values (distance pos) furthest)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-12.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,36 @@
+(defpackage :advent/2017/12 #.cl-user::*advent-use*)
+(in-package :advent/2017/12)
+
+(defun parse-line (line)
+ (destructuring-bind (id others) (str:split "<->" line)
+ (list (parse-integer id)
+ (mapcar #'parse-integer (str:split #\, others)))))
+
+(defun build-graph (records)
+ (iterate
+ (with graph = (digraph:make-digraph :initial-vertices (mapcar #'car records)))
+ (for (id others) :in records)
+ (dolist (id2 others)
+ (digraph:insert-edge graph id id2))
+ (finally (return graph))))
+
+(defun connected-to (graph start)
+ (gathering
+ (digraph:mapc-depth-first #'gather graph start)))
+
+(defun count-subgraph (graph start)
+ (length (connected-to graph start)))
+
+(defun remove-subgraph (graph start)
+ (map nil (alexandria:curry #'digraph:remove-vertex graph)
+ (connected-to graph start)))
+
+(define-problem (2017 12) (data read-lines) (141 171)
+ (let ((graph (build-graph (mapcar #'parse-line data))))
+ (values
+ (count-subgraph graph 0)
+ (iterate
+ (for vertex = (digraph:arbitrary-vertex graph))
+ (while vertex)
+ (remove-subgraph graph vertex)
+ (counting t)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-13.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,68 @@
+(defpackage :advent/2017/13 #.cl-user::*advent-use*)
+(in-package :advent/2017/13)
+
+;; There's a magical insight that you need to get if you want to do this
+;; problem: the length of a scanner of range R is `2(R-1)`.
+;;
+;; Examples:
+;;
+;; R = 2: S. 1
+;; .S 2 = 2(R-1) = 2(2-1) = 2(1) = 2
+;;
+;; R = 3: S.. 1
+;; .S. 2
+;; ..S 3
+;; .S. 4 = 2(R-1) = 2(3-1) = 2(2) = 4
+;;
+;; R = 4: S... 1
+;; .S.. 2
+;; ..S. 3
+;; ...S 4
+;; ..S. 5
+;; .S.. 6 = 2(R-1) = 2(4-1) = 2(3) = 6
+;;
+;; The best "intuition" I can come up with for this is:
+;;
+;; * We spend 1 turn at each end position.
+;; * We spend 2 turns at each inner position.
+;; * We have R positions, 2 of which are an end and (R-2) of which are inner.
+;; * So we have (2 * 1) + ((R-2) * 2) = 2 + 2(R-2) turns.
+;; * Factor out the 2 and simplify: 2(1 + (R-2)) = 2(R-1).
+;;
+;; Figuring out the exact position of a scanner at a given time it tricky
+;; because you need to wrap the position around properly during the second half,
+;; but we can skip that because all we care about is whether it's at zero.
+
+(defun catchesp (range time)
+ (zerop (mod time (* (1- range) 2))))
+
+(defun make-scanners (specs)
+ (iterate
+ (with scanners = (make-array (1+ (caar (last specs))) :initial-element nil))
+ (for (level range) :in specs)
+ (setf (aref scanners level) range)
+ (finally (return scanners))))
+
+(defun severity (level range)
+ (* level range))
+
+(defun traverse (scanners start-time)
+ (iterate
+ (for level :from 0)
+ (for time :from start-time)
+ (for range :in-vector scanners)
+ (for caught = (and range (catchesp range time)))
+ (oring caught :into ever-caught)
+ (when caught
+ (summing (severity level range) :into score))
+ (returning score ever-caught)))
+
+(define-problem (2017 13) (data read-lines-of-numbers-and-garbage)
+ (2604 3941460)
+ (let ((scanners (make-scanners data)))
+ (values
+ (traverse scanners 0)
+ (iterate
+ (for delay :from 0)
+ (for (values score caught) = (traverse scanners delay))
+ (finding delay :such-that (not caught))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-14.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,49 @@
+(defpackage :advent/2017/14 #.cl-user::*advent-use*)
+(in-package :advent/2017/14)
+
+(defun print-grid (grid)
+ (dotimes (row 128)
+ (dotimes (col 128)
+ (princ (if (aref grid row col) #\# #\.)))
+ (terpri)))
+
+(defun gref (grid point)
+ (let-complex ((row col point))
+ (when (and (in-range-p 0 row 128)
+ (in-range-p 0 col 128))
+ (aref grid row col))))
+
+(defun (setf gref) (new-value grid point)
+ (setf (aref grid (realpart point) (imagpart point)) new-value))
+
+(defun flood-region (grid row col)
+ (iterate
+ (with seen = (make-hash-set))
+ (with frontier = (make-hash-set :initial-contents (list (complex row col))))
+ (until (hset-empty-p frontier))
+ (for next = (hset-pop! frontier))
+ (when (not (hset-contains-p seen next))
+ (hset-insert! seen next)
+ (when (gref grid next)
+ (counting t)
+ (setf (gref grid next) nil)
+ (apply #'hset-insert! frontier (manhattan-neighbors next))))))
+
+(define-problem (2017 14) (data read-line) (8226 1128)
+ (multiple-value-bind (grid total)
+ (iterate
+ (with grid = (make-array '(128 128)))
+ (for row :from 0 :to 127)
+ (for hash = (advent/knot-hash:full-knot-hash
+ (format nil "~A-~D" data row)
+ :result-type 'integer))
+ (summing (logcount hash) :into total)
+ (dotimes (col 128)
+ (setf (aref grid row col)
+ (logbitp (- 127 col) hash)))
+ (returning grid total))
+ (values total
+ (iterate
+ (for-nested ((row :from 0 :to 127)
+ (col :from 0 :to 127)))
+ (counting (plusp (flood-region grid row col)))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/days/day-15.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,28 @@
+(defpackage :advent/2017/15 #.cl-user::*advent-use*)
+(in-package :advent/2017/15)
+
+(defun-inline gen (previous factor)
+ (rem (* previous factor) 2147483647))
+
+(defun-inline gen-harder (previous factor divisor)
+ (iterate
+ (for x :seed previous :then (gen x factor))
+ (finding x :such-that (dividesp x divisor))))
+
+(defun-inline matchp (a b)
+ (= (ldb (byte 16 0) a)
+ (ldb (byte 16 0) b)))
+
+(define-problem (2017 15) (data read-numbers) (650)
+ (destructuring-bind (a-start b-start) data
+ (values
+ (iterate
+ (repeat 40000000)
+ (for a :seed a-start :then (gen a 16807))
+ (for b :seed b-start :then (gen b 48271))
+ (counting (matchp a b)))
+ (iterate
+ (repeat 5000000)
+ (for a :seed a-start :then (gen-harder a 16807 4))
+ (for b :seed b-start :then (gen-harder b 48271 8))
+ (counting (matchp a b))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/knot-hash.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,62 @@
+(defpackage :advent/knot-hash
+ #.cl-user::*advent-use*
+ (:export :simple-knot-hash :full-knot-hash))
+
+(in-package :advent/knot-hash)
+
+(defun reverse-chunk (vector start length)
+ (iterate
+ (repeat (truncate length 2))
+ (for i :modulo (length vector) :from start)
+ (for j :modulo (length vector) :downfrom (+ start (1- length)))
+ (rotatef (aref vector i) (aref vector j))))
+
+(defun simple-knot-hash (lengths)
+ (iterate
+ (with numbers = (coerce (alexandria:iota 256) 'vector))
+ (with current = 0)
+ (with skip = 0)
+ (for length :in lengths)
+ (reverse-chunk numbers current length)
+ (zapf current (mod (+ % length skip) 256))
+ (incf skip)
+ (finally (return (* (aref numbers 0) (aref numbers 1))))))
+
+(defun sparse->dense (numbers)
+ (iterate
+ (for i :from 0 :by 16 :below (length numbers))
+ (collect (reduce #'logxor numbers :start i :end (+ i 16)))))
+
+(defun bytes->hex (bytes)
+ (format nil "~(~{~2,'0X~}~)" bytes))
+
+(defun bytes->integer (bytes)
+ (iterate
+ (for byte :in bytes)
+ (for result :seed 0 :then (+ (ash result 8) byte))
+ (returning result)))
+
+(defun initial-lengths (string)
+ (append (map 'list #'char-code string)
+ (list 17 31 73 47 23)))
+
+(defun full-knot-hash (string &key (result-type 'string))
+ (iterate
+ (with lengths = (initial-lengths string))
+ (with numbers = (coerce (alexandria:iota 256) 'vector))
+ (with current = 0)
+ (with skip = 0)
+ (repeat 64)
+ (iterate
+ (for length :in lengths)
+ (reverse-chunk numbers current length)
+ (zapf current (mod (+ % length skip) 256))
+ (incf skip))
+ (returning
+ (let ((hash (sparse->dense numbers)))
+ (ecase result-type
+ (string (bytes->hex hash))
+ (list hash)
+ (vector (coerce hash 'vector))
+ (integer (bytes->integer hash)))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2017/number-spiral.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,90 @@
+(defpackage :advent/spiral
+ (:use :cl :losh :iterate :advent.quickutils)
+ (:export :number-coordinates))
+
+(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))))
--- a/src/2018/day-01.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,16 +0,0 @@
-(defpackage :advent/2018/01 #.cl-user::*advent-use*)
-(in-package :advent/2018/01)
-
-
-(define-problem (2018 1) (data read-all) (522 73364)
- (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/day-02.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-(defpackage :advent/2018/02 #.cl-user::*advent-use*)
-(in-package :advent/2018/02)
-
-
-(define-problem (2018 2) (data read-lines) (8296 "pazvmqbftrbeosiecxlghkwud")
- (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/day-03.lisp Thu Dec 05 19:36:23 2019 -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) (107663 1166)
- (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/day-04.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +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) (143415 49944)
- (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/day-05.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +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)
- (10708 5330)
- (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/day-06.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,44 +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) (3420 46667)
- (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/day-07.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,61 +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) ("BFGKNRTWXIHPUMLQVZOYJACDSE" 1163)
- (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/day-08.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +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) (37905 33891)
- (let ((root (read-node data)))
- (values
- (recursively ((node root))
- (+ (summation (metadata node))
- (summation (children node) :key #'recur)))
- (node-value root))))
--- a/src/2018/day-09.lisp Thu Dec 05 19:36:23 2019 -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)
- (398730 3349635509)
- (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/day-10.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-(defpackage :advent/2018/10 #.cl-user::*advent-use*
- (:shadow :x))
-(in-package :advent/2018/10)
-
-(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)
- () ;; This can't really be tested automatically :(
- (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/day-11.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-(defpackage :advent/2018/11 #.cl-user::*advent-use*
- (:shadow :x :y))
-(in-package :advent/2018/11)
-
-(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) ("245,14" "235,206,13")
- (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 (str:join "," (subseq (largest-square 3) 0 2))
- (iterate (for n :from 1 :to 300)
- (for (x y power) = (largest-square n))
- (finding (format nil "~D,~D,~D" x y n)
- :maximizing power)))))))
--- a/src/2018/day-12.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,130 +0,0 @@
-(defpackage :advent/2018/12 #.cl-user::*advent-use*)
-(in-package :advent/2018/12)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-;;;; Pots ---------------------------------------------------------------------
-(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 (plusp (pot o i)) #\# #\.)
- :result-type 'string)))))
-
-
-(defun-inline pot (pots i)
- (if (hset-contains-p (pots-data pots) i)
- 1
- 0))
-
-(defun add-pot (pots i)
- (hset-insert! (pots-data pots) i))
-
-(defun rem-pot (pots i)
- (hset-remove! (pots-data pots) i))
-
-(defun surroundings (pots i)
- (make-array 5
- :element-type 'bit
- :initial-contents (list (pot pots (- i 2))
- (pot pots (- i 1))
- (pot pots i)
- (pot pots (+ i 1))
- (pot pots (+ i 2)))))
-
-(defun score (pots)
- (summation (hset-elements (pots-data pots))))
-
-
-;;;; Input Parsing ------------------------------------------------------------
-(defun rune-bit (rune)
- (ecase rune
- (#\# 1)
- (#\. 0)))
-
-(defun runes-to-bits (runes)
- (map 'bit-vector #'rune-bit runes))
-
-(defun vector-to-hash-set (vector &key (test #'eql))
- (iterate
- (with result = (make-hash-set :test test))
- (for value :in-vector vector :with-index i)
- (when (plusp value)
- (hset-insert! result i))))
-
-(defun parse-initial-line (line)
- (ppcre:register-groups-bind
- (state)
- (#?r"initial state: (\S+)" line)
- (-<> state
- runes-to-bits
- (positions-if #'plusp <>)
- (make-hash-set :initial-contents <>))))
-
-(defun parse-rule (line)
- (ppcre:register-groups-bind
- (surroundings result)
- (#?r"(\S+) => (\S)" line)
- (values (runes-to-bits surroundings)
- (rune-bit (aref result 0)))))
-
-(defun read-problem (stream)
- (let* ((initial (parse-initial-line (read-line stream)))
- (state (prog1 (make-pots :data initial
- :min (extremum (hset-elements initial) '<)
- :max (extremum (hset-elements initial) '>))
- (read-line stream)))
- (rules (iterate
- (for line :in-stream stream :using #'read-line)
- (unless (string= "" line)
- (for (values key result) = (parse-rule line))
- (collect-hash (key result) :test #'equal)))))
- (values state rules)))
-
-
-;;;; Solve --------------------------------------------------------------------
-(defun tick (pots rules)
- (with-slots (min max) pots
- (iterate
- (for i :from (- min 2) :to (+ max 2))
- (for current = (pot pots i))
- (for surroundings = (surroundings pots i))
- (for next = (gethash surroundings rules))
- (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
- (map nil (curry #'add-pot pots) add)
- (map nil (curry #'rem-pot pots) rem)
- (setf min next-min
- max next-max)
- pots))))
-
-(define-problem (2018 12) (data)
- () ;; can't really test noninteractively :(
- (multiple-value-bind (pots rules) (read-problem data)
- (values
- (progn
- (do-repeat 20
- (tick pots rules))
- (score pots))
- (iterate
- (for tick :from 20)
- (format t "~%After ~D tick~:P:~%~A~%score: ~D~%> " tick pots (score pots))
- (force-output)
- (for input = (read-line))
- (until (string= "q" input))
- (tick pots rules)))))
-
-(defun part-2 ()
- (let* ((score-per-tick 20)
- (starting-tick 350)
- (starting-value 7508)
- (ticks (- 50000000000 starting-tick)))
- (+ starting-value (* score-per-tick ticks))))
--- a/src/2018/day-13.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,207 +0,0 @@
-(defpackage :advent/2018/13 #.cl-user::*advent-use*)
-(in-package :advent/2018/13)
-
-;;;; Cart ---------------------------------------------------------------------
-(defun left (velocity)
- (* #c(0 -1) velocity))
-
-(defun right (velocity)
- (* #c(0 1) velocity))
-
-(defun straight (velocity)
- velocity)
-
-(defun horizontalp (velocity)
- (zerop (imagpart velocity)))
-
-(defun verticalp (velocity)
- (zerop (realpart velocity)))
-
-
-(defparameter *ai* '#1=(left straight right . #1#))
-
-(defstruct cart
- position
- velocity
- (ai *ai*))
-
-
-(defun turn-intersection (cart)
- (callf (cart-velocity cart) (pop (cart-ai cart))))
-
-(defun turn-corner (cart corner)
- (callf (cart-velocity cart)
- (let ((v (verticalp (cart-velocity cart))))
- (ecase corner
- (#\\ (if v #'left #'right))
- (#\/ (if v #'right #'left))))))
-
-
-(defun cart-rune (cart)
- (ecase (cart-velocity cart)
- (#c(0 -1) #\^)
- (#c(0 1) #\v)
- (#c(-1 0) #\<)
- (#c(1 0) #\>)))
-
-
-;;;; Carts ---------------------------------------------------------------------
-(defun make-carts (sequence)
- (iterate (for cart :in-whatever sequence)
- (collect-hash ((cart-position cart) cart))))
-
-(defun cart-at (carts position)
- (gethash position carts))
-
-(defun insert-cart (carts cart)
- (setf (gethash (cart-position cart) carts) cart))
-
-(defun remove-cart (carts cart)
- (remhash (cart-position cart) carts))
-
-(define-condition collision ()
- ((position :initarg :position :accessor collision-position)))
-
-(defun move-cart (carts cart)
- (with-slots (position velocity) cart
- (remove-cart carts cart)
- (incf position velocity)
- (if-let ((other-cart (cart-at carts position)))
- (restart-case (error 'collision :position position)
- (remove-crashed-carts ()
- (remove-cart carts other-cart)
- (push cart *dead-carts*)
- (push other-cart *dead-carts*)))
- (insert-cart carts cart)))
- (values))
-
-(defun remove-crashed-carts (condition)
- (declare (ignore condition))
- (invoke-restart 'remove-crashed-carts))
-
-
-;;;; Track --------------------------------------------------------------------
-(deftype track ()
- '(simple-array character (* *)))
-
-(defun track-at (track position)
- (aref track (realpart position) (imagpart position)))
-
-(defun print-track (track carts)
- (destructuring-bind (width height) (array-dimensions track)
- (dotimes (y height)
- (dotimes (x width)
- (when (zerop x)
- (terpri))
- (write-char
- (if-let ((cart (cart-at carts (complex x y))))
- (cart-rune cart)
- (aref track x y)))))
- (terpri)))
-
-(defun cornerp (track position)
- (find (track-at track position) "\\/"))
-
-(defun intersectionp (track position)
- (char= (track-at track position) #\+))
-
-
-;;;; Input Parsing ------------------------------------------------------------
-(defun cart-rune-velocity (rune)
- (ecase rune
- (#\^ #c(0 -1))
- (#\v #c(0 1))
- (#\< #c(-1 0))
- (#\> #c(1 0))))
-
-(defun cart-rune-p (rune)
- (find rune "^v<>"))
-
-(defun track-rune (cart-or-track-rune)
- (case cart-or-track-rune
- ((#\^ #\v) #\|)
- ((#\< #\>) #\-)
- (t cart-or-track-rune)))
-
-(defun parse-track (lines)
- (removef lines "" :test #'string=)
- (let ((track (make-array (list (extremum (mapcar #'length lines) '>)
- (length lines))
- :element-type 'character
- :initial-element #\space))
- (carts nil))
- (iterate
- (for line :in lines)
- (for y :from 0)
- (iterate
- (for rune :in-string line)
- (for x :from 0)
- (when (cart-rune-p rune)
- (push (make-cart
- :position (complex x y)
- :velocity (cart-rune-velocity rune))
- carts))
- (setf (aref track x y) (track-rune rune))))
- (values track (make-carts carts))))
-
-
-;;;; Simulation ---------------------------------------------------------------
-(defparameter *dead-carts* nil)
-
-(defun tick-cart (track carts cart)
- (unless (member cart *dead-carts*)
- (move-cart carts cart)
- (let ((pos (cart-position cart)))
- (cond
- ((cornerp track pos) (turn-corner cart (track-at track pos)))
- ((intersectionp track pos) (turn-intersection cart)))))
- (values))
-
-(defun cart< (cart1 cart2)
- (let* ((p1 (cart-position cart1))
- (p2 (cart-position cart2))
- (x1 (realpart p1))
- (y1 (imagpart p1))
- (x2 (realpart p2))
- (y2 (imagpart p2)))
- ;; cart1 moves before cart2 if it's:
- (or (< y1 y2) ; higher up
- (and (= y1 y2) (< x1 x2))))) ; or further left
-
-(defun tick-carts (track carts)
- (dolist (cart (sort (hash-table-values carts) #'cart<))
- (tick-cart track carts cart)))
-
-
-;;;; Solve --------------------------------------------------------------------
-(defparameter *example* (format nil "
-/->-\\
-| | /----\\
-| /-+--+-\\ |
-| | | | v |
-\\-+-/ \\-+--/
- \\------/
-"))
-
-(defun format-position (position)
- (format nil "~D,~D" (realpart position) (imagpart position)))
-
-(defun part-1 (lines)
- (multiple-value-bind (track carts) (parse-track lines)
- (handler-case (loop (tick-carts track carts))
- (collision (collision) (format-position (collision-position collision))))))
-
-(defun part-2 (lines)
- (multiple-value-bind (track carts) (parse-track lines)
- (handler-bind ((collision #'remove-crashed-carts))
- (iterate
- (tick-carts track carts)
- (for tick :from 1)
- (for carts-remaining = (hash-table-count carts))
- (finding
- (-<> carts hash-table-values first cart-position format-position)
- :such-that (= 1 carts-remaining))))))
-
-(define-problem (2018 13) (data read-lines) ("83,49" "73,36")
- (values (part-1 data)
- (part-2 data)))
--- a/src/2018/day-14.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,45 +0,0 @@
-(defpackage :advent/2018/14 #.cl-user::*advent-use*)
-(in-package :advent/2018/14)
-
-(defun combine (recipes elves)
- (digits (summation elves :key (curry #'aref recipes))))
-
-(defun move-elves (recipes elves)
- (do-array (elf elves)
- (setf elf (mod (+ elf (aref recipes elf) 1)
- (length recipes)))))
-
-(defun format-output (scores)
- (str:join "" (coerce scores 'list)))
-
-(define-problem (2018 14) (data read) ("3610281143" 20211326)
- #+sbcl (sb-ext:gc :full t)
- (iterate
- (with recipes = (make-array 2
- :adjustable t
- :fill-pointer t
- :initial-contents '(3 7)))
- (with elves = (make-array 2 :initial-contents '(0 1)))
- (with part-1 = nil)
- (with part-2 = nil)
- (with target = (digits data :result-type 'vector))
- (with target-length = (length target))
-
- (until (and part-1 part-2))
-
- (unless part-1
- (when (>= (length recipes) (+ 10 data))
- (setf part-1 (format-output (subseq recipes data (+ data 10))))))
-
- (iterate (for new-recipe :in (combine recipes elves))
- (vector-push-extend new-recipe recipes)
- (for len = (length recipes))
- (for left = (- len target-length))
- (unless part-2
- (when (and (not (minusp left))
- (search target recipes :start2 left))
- (setf part-2 left))))
-
- (move-elves recipes elves)
-
- (finally (return (values part-1 part-2)))))
--- a/src/2018/day-15.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,255 +0,0 @@
-(defpackage :advent/2018/15 #.cl-user::*advent-use*)
-(in-package :advent/2018/15)
-
-;;;; Points -------------------------------------------------------------------
-(defun p (row col) (complex row col))
-(defun row (p) (realpart p))
-(defun col (p) (imagpart p))
-
-(defun p< (p1 p2)
- (or (< (row p1) (row p2))
- (and (= (row p1) (row p2))
- (< (col p1) (col p2)))))
-
-(defun neighbors (p)
- (list (+ p #c(0 1))
- (+ p #c(1 0))
- (+ p #c(0 -1))
- (+ p #c(-1 0))))
-
-(defun distance (p1 p2)
- (abs (- p1 p2)))
-
-
-;;;; Loc ----------------------------------------------------------------------
-(defvar *locations* nil)
-
-(beast:define-aspect loc p)
-
-(defun loc/row (entity) (row (loc/p entity)))
-(defun loc/col (entity) (col (loc/p entity)))
-
-
-(defun initialize-loc (rows cols)
- (setf *locations* (make-array (list rows cols) :initial-element nil)))
-
-(defmethod beast:entity-created :after ((entity loc))
- (setf (aref *locations* (loc/row entity) (loc/col entity)) entity))
-
-(defmethod beast:entity-destroyed :after ((entity loc))
- (when (loc/p entity)
- (setf (aref *locations* (loc/row entity) (loc/col entity)) nil)))
-
-
-(defun move (entity p)
- (setf (aref *locations* (loc/row entity) (loc/col entity)) nil
- (loc/p entity) p
- (aref *locations* (loc/row entity) (loc/col entity)) entity))
-
-(defun loc (p)
- (aref *locations* (row p) (col p)))
-
-(defun loc< (e1 e2)
- (p< (loc/p e1) (loc/p e2)))
-
-
-;;;; Other Aspects ------------------------------------------------------------
-(beast:define-aspect living (hp :initform 200))
-(beast:define-aspect fighter (attack-power :initform 3))
-(beast:define-aspect renderable (glyph))
-
-
-;;;; Entities -----------------------------------------------------------------
-(defvar *dead* nil)
-
-(beast:define-entity elf (loc living fighter renderable))
-(beast:define-entity goblin (loc living fighter renderable))
-
-(defmethod print-object ((o elf) s)
- (print-unreadable-object (o s :type t)
- (format s "~A ~D" (loc/p o) (living/hp o))))
-
-(defmethod print-object ((o goblin) s)
- (print-unreadable-object (o s :type t)
- (format s "~A ~D" (loc/p o) (living/hp o))))
-
-
-(defun create-elf (p)
- (beast:create-entity 'elf :loc/p p :renderable/glyph #\E))
-
-(defun create-goblin (p)
- (beast:create-entity 'goblin :loc/p p :renderable/glyph #\G))
-
-
-(defun entities-to-move ()
- (sort (beast:map-entities #'identity) #'loc<))
-
-(defun enemiesp (e1 e2)
- (typep e2 (etypecase e1
- (goblin 'elf)
- (elf 'goblin))))
-
-(defun targets (entity)
- (beast:map-entities #'identity (etypecase entity
- (goblin 'elf)
- (elf 'goblin))))
-
-(defun attack (attacker defender)
- (decf (living/hp defender)
- (fighter/attack-power attacker))
- (unless (plusp (living/hp defender))
- (push defender *dead*)
- (beast:destroy-entity defender)))
-
-
-;;;; Terrain ------------------------------------------------------------------
-(defvar *terrain* nil)
-
-(defun initialize-terrain (rows cols)
- (setf *terrain* (make-array (list rows cols)
- :element-type 'character
- :initial-element #\.)))
-
-
-(defun terrain (p)
- (aref *terrain* (row p) (col p)))
-
-(defun (setf terrain) (new-value p)
- (setf (aref *terrain* (row p) (col p)) new-value))
-
-
-(defun passablep (p)
- (case (terrain p)
- (#\# nil)
- (t t)))
-
-
-;;;; World --------------------------------------------------------------------
-(defun openp (p)
- (and (null (loc p))
- (passablep p)))
-
-(defun in-bounds-p (p)
- (array-in-bounds-p *terrain* (row p) (col p)))
-
-(defun open-neighbors (p)
- (remove-if-not (alexandria:conjoin #'openp #'in-bounds-p)
- (neighbors p)))
-
-(defun adjacent-enemies (mob)
- (-<> mob
- loc/p
- neighbors
- (mapcar #'loc <>)
- (remove nil <>)
- (remove-if-not (curry #'enemiesp mob) <>)))
-
-(defun adjacent-enemy (mob)
- (first (sort (adjacent-enemies mob) #'loc<)))
-
-(defun target-squares (unit)
- (-<> unit
- targets
- (mapcan (compose #'open-neighbors #'loc/p) <>)
- (remove-duplicates <> :test #'=)))
-
-
-(defun step-cost (start from to)
- ;; We adjust the cost of the first step of our path to account for the
- ;; bullshit reading order tie breaking (but never enough to send us the wrong
- ;; way).
- (if (= from start)
- (ecase (- to from)
- (#c(-1 0) 1)
- (#c(0 -1) 1.1)
- (#c(0 1) 1.2)
- (#c(1 0) 1.3))
- 1))
-
-(defun action (mob)
- (if-let ((enemy (adjacent-enemy mob)))
- (values :attack enemy)
- (iterate
- (with goals = (target-squares mob))
- (with start = (loc/p mob))
- (with best-goal = nil)
- (with best-path = nil)
- (with best-cost = nil)
- (for goal :in goals)
- (for path = (astar :start start
- :neighbors #'open-neighbors
- :goalp (curry #'= goal)
- :cost (curry #'step-cost start)
- :limit best-cost
- :heuristic (curry #'distance goal)
- :test #'eql))
- (when path
- (for cost = (length path))
- (when (or (null best-path) ; this is the first path
- (< cost best-cost) ; this is a shorter path
- (p< goal best-goal)) ; this is a better destination by reading order
- (setf best-path path
- best-goal goal
- best-cost cost)))
- (finally (return (if best-path
- (values :move (second best-path))
- (values :wait)))))))
-
-
-(defun tick-mob (mob)
- (unless (member mob *dead*)
- (multiple-value-bind (action target) (action mob)
- (ecase action
- (:attack
- (pr mob 'attacking target)
- (attack mob target))
- (:move
- (pr mob 'moving 'to target)
- (move mob target))
- (:wait
- (pr mob 'waiting))))))
-
-
-(defun tick-world ()
- (let ((*dead* nil))
- (map nil #'tick-mob (entities-to-move))))
-
-
-;;;; World Generation ---------------------------------------------------------
-(defun generate-world (lines)
- (removef lines "" :test #'string=)
- (beast:clear-entities)
- (let* ((rows (length lines))
- (cols (length (first lines))))
- (initialize-loc rows cols)
- (initialize-terrain rows cols)
- (iterate
- (for line :in lines)
- (for row :from 0)
- (iterate
- (for char :in-string line :with-index col)
- (for p = (p row col))
- (case char
- (#\E (create-elf p))
- (#\G (create-goblin p))
- (#\# (setf (terrain p) #\#))
- (t nil))))))
-
-(defun print-world (&optional path)
- (iterate
- (for (char row col) :in-array *terrain*)
- (for p = (p row col))
- (for mob = (loc p))
- (when (zerop col)
- (terpri))
- (write-char (cond
- ((member p path) #\x)
- (mob (renderable/glyph mob))
- (t char))))
- (terpri)
- (values))
-
-
-(define-problem (2018 15) (data read-lines) ()
- (generate-world data)
- (print-world))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/days/day-01.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,16 @@
+(defpackage :advent/2018/01 #.cl-user::*advent-use*)
+(in-package :advent/2018/01)
+
+
+(define-problem (2018 1) (data read-all) (522 73364)
+ (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/days/day-02.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,20 @@
+(defpackage :advent/2018/02 #.cl-user::*advent-use*)
+(in-package :advent/2018/02)
+
+
+(define-problem (2018 2) (data read-lines) (8296 "pazvmqbftrbeosiecxlghkwud")
+ (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/days/day-03.lisp Thu Dec 05 20:45:46 2019 -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) (107663 1166)
+ (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/days/day-04.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,67 @@
+(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) (143415 49944)
+ (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/days/day-05.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,23 @@
+(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)
+ (10708 5330)
+ (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/days/day-06.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,44 @@
+(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) (3420 46667)
+ (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/days/day-07.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,61 @@
+(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) ("BFGKNRTWXIHPUMLQVZOYJACDSE" 1163)
+ (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/days/day-08.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,33 @@
+(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) (37905 33891)
+ (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/days/day-09.lisp Thu Dec 05 20:45:46 2019 -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)
+ (398730 3349635509)
+ (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/days/day-10.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,56 @@
+(defpackage :advent/2018/10 #.cl-user::*advent-use*
+ (:shadow :x))
+(in-package :advent/2018/10)
+
+(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)
+ () ;; This can't really be tested automatically :(
+ (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/days/day-11.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,59 @@
+(defpackage :advent/2018/11 #.cl-user::*advent-use*
+ (:shadow :x :y))
+(in-package :advent/2018/11)
+
+(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) ("245,14" "235,206,13")
+ (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 (str:join "," (subseq (largest-square 3) 0 2))
+ (iterate (for n :from 1 :to 300)
+ (for (x y power) = (largest-square n))
+ (finding (format nil "~D,~D,~D" x y n)
+ :maximizing power)))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/days/day-12.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,130 @@
+(defpackage :advent/2018/12 #.cl-user::*advent-use*)
+(in-package :advent/2018/12)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+;;;; Pots ---------------------------------------------------------------------
+(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 (plusp (pot o i)) #\# #\.)
+ :result-type 'string)))))
+
+
+(defun-inline pot (pots i)
+ (if (hset-contains-p (pots-data pots) i)
+ 1
+ 0))
+
+(defun add-pot (pots i)
+ (hset-insert! (pots-data pots) i))
+
+(defun rem-pot (pots i)
+ (hset-remove! (pots-data pots) i))
+
+(defun surroundings (pots i)
+ (make-array 5
+ :element-type 'bit
+ :initial-contents (list (pot pots (- i 2))
+ (pot pots (- i 1))
+ (pot pots i)
+ (pot pots (+ i 1))
+ (pot pots (+ i 2)))))
+
+(defun score (pots)
+ (summation (hset-elements (pots-data pots))))
+
+
+;;;; Input Parsing ------------------------------------------------------------
+(defun rune-bit (rune)
+ (ecase rune
+ (#\# 1)
+ (#\. 0)))
+
+(defun runes-to-bits (runes)
+ (map 'bit-vector #'rune-bit runes))
+
+(defun vector-to-hash-set (vector &key (test #'eql))
+ (iterate
+ (with result = (make-hash-set :test test))
+ (for value :in-vector vector :with-index i)
+ (when (plusp value)
+ (hset-insert! result i))))
+
+(defun parse-initial-line (line)
+ (ppcre:register-groups-bind
+ (state)
+ (#?r"initial state: (\S+)" line)
+ (-<> state
+ runes-to-bits
+ (positions-if #'plusp <>)
+ (make-hash-set :initial-contents <>))))
+
+(defun parse-rule (line)
+ (ppcre:register-groups-bind
+ (surroundings result)
+ (#?r"(\S+) => (\S)" line)
+ (values (runes-to-bits surroundings)
+ (rune-bit (aref result 0)))))
+
+(defun read-problem (stream)
+ (let* ((initial (parse-initial-line (read-line stream)))
+ (state (prog1 (make-pots :data initial
+ :min (extremum (hset-elements initial) '<)
+ :max (extremum (hset-elements initial) '>))
+ (read-line stream)))
+ (rules (iterate
+ (for line :in-stream stream :using #'read-line)
+ (unless (string= "" line)
+ (for (values key result) = (parse-rule line))
+ (collect-hash (key result) :test #'equal)))))
+ (values state rules)))
+
+
+;;;; Solve --------------------------------------------------------------------
+(defun tick (pots rules)
+ (with-slots (min max) pots
+ (iterate
+ (for i :from (- min 2) :to (+ max 2))
+ (for current = (pot pots i))
+ (for surroundings = (surroundings pots i))
+ (for next = (gethash surroundings rules))
+ (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
+ (map nil (curry #'add-pot pots) add)
+ (map nil (curry #'rem-pot pots) rem)
+ (setf min next-min
+ max next-max)
+ pots))))
+
+(define-problem (2018 12) (data)
+ () ;; can't really test noninteractively :(
+ (multiple-value-bind (pots rules) (read-problem data)
+ (values
+ (progn
+ (do-repeat 20
+ (tick pots rules))
+ (score pots))
+ (iterate
+ (for tick :from 20)
+ (format t "~%After ~D tick~:P:~%~A~%score: ~D~%> " tick pots (score pots))
+ (force-output)
+ (for input = (read-line))
+ (until (string= "q" input))
+ (tick pots rules)))))
+
+(defun part-2 ()
+ (let* ((score-per-tick 20)
+ (starting-tick 350)
+ (starting-value 7508)
+ (ticks (- 50000000000 starting-tick)))
+ (+ starting-value (* score-per-tick ticks))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/days/day-13.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,207 @@
+(defpackage :advent/2018/13 #.cl-user::*advent-use*)
+(in-package :advent/2018/13)
+
+;;;; Cart ---------------------------------------------------------------------
+(defun left (velocity)
+ (* #c(0 -1) velocity))
+
+(defun right (velocity)
+ (* #c(0 1) velocity))
+
+(defun straight (velocity)
+ velocity)
+
+(defun horizontalp (velocity)
+ (zerop (imagpart velocity)))
+
+(defun verticalp (velocity)
+ (zerop (realpart velocity)))
+
+
+(defparameter *ai* '#1=(left straight right . #1#))
+
+(defstruct cart
+ position
+ velocity
+ (ai *ai*))
+
+
+(defun turn-intersection (cart)
+ (callf (cart-velocity cart) (pop (cart-ai cart))))
+
+(defun turn-corner (cart corner)
+ (callf (cart-velocity cart)
+ (let ((v (verticalp (cart-velocity cart))))
+ (ecase corner
+ (#\\ (if v #'left #'right))
+ (#\/ (if v #'right #'left))))))
+
+
+(defun cart-rune (cart)
+ (ecase (cart-velocity cart)
+ (#c(0 -1) #\^)
+ (#c(0 1) #\v)
+ (#c(-1 0) #\<)
+ (#c(1 0) #\>)))
+
+
+;;;; Carts ---------------------------------------------------------------------
+(defun make-carts (sequence)
+ (iterate (for cart :in-whatever sequence)
+ (collect-hash ((cart-position cart) cart))))
+
+(defun cart-at (carts position)
+ (gethash position carts))
+
+(defun insert-cart (carts cart)
+ (setf (gethash (cart-position cart) carts) cart))
+
+(defun remove-cart (carts cart)
+ (remhash (cart-position cart) carts))
+
+(define-condition collision ()
+ ((position :initarg :position :accessor collision-position)))
+
+(defun move-cart (carts cart)
+ (with-slots (position velocity) cart
+ (remove-cart carts cart)
+ (incf position velocity)
+ (if-let ((other-cart (cart-at carts position)))
+ (restart-case (error 'collision :position position)
+ (remove-crashed-carts ()
+ (remove-cart carts other-cart)
+ (push cart *dead-carts*)
+ (push other-cart *dead-carts*)))
+ (insert-cart carts cart)))
+ (values))
+
+(defun remove-crashed-carts (condition)
+ (declare (ignore condition))
+ (invoke-restart 'remove-crashed-carts))
+
+
+;;;; Track --------------------------------------------------------------------
+(deftype track ()
+ '(simple-array character (* *)))
+
+(defun track-at (track position)
+ (aref track (realpart position) (imagpart position)))
+
+(defun print-track (track carts)
+ (destructuring-bind (width height) (array-dimensions track)
+ (dotimes (y height)
+ (dotimes (x width)
+ (when (zerop x)
+ (terpri))
+ (write-char
+ (if-let ((cart (cart-at carts (complex x y))))
+ (cart-rune cart)
+ (aref track x y)))))
+ (terpri)))
+
+(defun cornerp (track position)
+ (find (track-at track position) "\\/"))
+
+(defun intersectionp (track position)
+ (char= (track-at track position) #\+))
+
+
+;;;; Input Parsing ------------------------------------------------------------
+(defun cart-rune-velocity (rune)
+ (ecase rune
+ (#\^ #c(0 -1))
+ (#\v #c(0 1))
+ (#\< #c(-1 0))
+ (#\> #c(1 0))))
+
+(defun cart-rune-p (rune)
+ (find rune "^v<>"))
+
+(defun track-rune (cart-or-track-rune)
+ (case cart-or-track-rune
+ ((#\^ #\v) #\|)
+ ((#\< #\>) #\-)
+ (t cart-or-track-rune)))
+
+(defun parse-track (lines)
+ (removef lines "" :test #'string=)
+ (let ((track (make-array (list (extremum (mapcar #'length lines) '>)
+ (length lines))
+ :element-type 'character
+ :initial-element #\space))
+ (carts nil))
+ (iterate
+ (for line :in lines)
+ (for y :from 0)
+ (iterate
+ (for rune :in-string line)
+ (for x :from 0)
+ (when (cart-rune-p rune)
+ (push (make-cart
+ :position (complex x y)
+ :velocity (cart-rune-velocity rune))
+ carts))
+ (setf (aref track x y) (track-rune rune))))
+ (values track (make-carts carts))))
+
+
+;;;; Simulation ---------------------------------------------------------------
+(defparameter *dead-carts* nil)
+
+(defun tick-cart (track carts cart)
+ (unless (member cart *dead-carts*)
+ (move-cart carts cart)
+ (let ((pos (cart-position cart)))
+ (cond
+ ((cornerp track pos) (turn-corner cart (track-at track pos)))
+ ((intersectionp track pos) (turn-intersection cart)))))
+ (values))
+
+(defun cart< (cart1 cart2)
+ (let* ((p1 (cart-position cart1))
+ (p2 (cart-position cart2))
+ (x1 (realpart p1))
+ (y1 (imagpart p1))
+ (x2 (realpart p2))
+ (y2 (imagpart p2)))
+ ;; cart1 moves before cart2 if it's:
+ (or (< y1 y2) ; higher up
+ (and (= y1 y2) (< x1 x2))))) ; or further left
+
+(defun tick-carts (track carts)
+ (dolist (cart (sort (hash-table-values carts) #'cart<))
+ (tick-cart track carts cart)))
+
+
+;;;; Solve --------------------------------------------------------------------
+(defparameter *example* (format nil "
+/->-\\
+| | /----\\
+| /-+--+-\\ |
+| | | | v |
+\\-+-/ \\-+--/
+ \\------/
+"))
+
+(defun format-position (position)
+ (format nil "~D,~D" (realpart position) (imagpart position)))
+
+(defun part-1 (lines)
+ (multiple-value-bind (track carts) (parse-track lines)
+ (handler-case (loop (tick-carts track carts))
+ (collision (collision) (format-position (collision-position collision))))))
+
+(defun part-2 (lines)
+ (multiple-value-bind (track carts) (parse-track lines)
+ (handler-bind ((collision #'remove-crashed-carts))
+ (iterate
+ (tick-carts track carts)
+ (for tick :from 1)
+ (for carts-remaining = (hash-table-count carts))
+ (finding
+ (-<> carts hash-table-values first cart-position format-position)
+ :such-that (= 1 carts-remaining))))))
+
+(define-problem (2018 13) (data read-lines) ("83,49" "73,36")
+ (values (part-1 data)
+ (part-2 data)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/days/day-14.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,45 @@
+(defpackage :advent/2018/14 #.cl-user::*advent-use*)
+(in-package :advent/2018/14)
+
+(defun combine (recipes elves)
+ (digits (summation elves :key (curry #'aref recipes))))
+
+(defun move-elves (recipes elves)
+ (do-array (elf elves)
+ (setf elf (mod (+ elf (aref recipes elf) 1)
+ (length recipes)))))
+
+(defun format-output (scores)
+ (str:join "" (coerce scores 'list)))
+
+(define-problem (2018 14) (data read) ("3610281143" 20211326)
+ #+sbcl (sb-ext:gc :full t)
+ (iterate
+ (with recipes = (make-array 2
+ :adjustable t
+ :fill-pointer t
+ :initial-contents '(3 7)))
+ (with elves = (make-array 2 :initial-contents '(0 1)))
+ (with part-1 = nil)
+ (with part-2 = nil)
+ (with target = (digits data :result-type 'vector))
+ (with target-length = (length target))
+
+ (until (and part-1 part-2))
+
+ (unless part-1
+ (when (>= (length recipes) (+ 10 data))
+ (setf part-1 (format-output (subseq recipes data (+ data 10))))))
+
+ (iterate (for new-recipe :in (combine recipes elves))
+ (vector-push-extend new-recipe recipes)
+ (for len = (length recipes))
+ (for left = (- len target-length))
+ (unless part-2
+ (when (and (not (minusp left))
+ (search target recipes :start2 left))
+ (setf part-2 left))))
+
+ (move-elves recipes elves)
+
+ (finally (return (values part-1 part-2)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/days/day-15.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,255 @@
+(defpackage :advent/2018/15 #.cl-user::*advent-use*)
+(in-package :advent/2018/15)
+
+;;;; Points -------------------------------------------------------------------
+(defun p (row col) (complex row col))
+(defun row (p) (realpart p))
+(defun col (p) (imagpart p))
+
+(defun p< (p1 p2)
+ (or (< (row p1) (row p2))
+ (and (= (row p1) (row p2))
+ (< (col p1) (col p2)))))
+
+(defun neighbors (p)
+ (list (+ p #c(0 1))
+ (+ p #c(1 0))
+ (+ p #c(0 -1))
+ (+ p #c(-1 0))))
+
+(defun distance (p1 p2)
+ (abs (- p1 p2)))
+
+
+;;;; Loc ----------------------------------------------------------------------
+(defvar *locations* nil)
+
+(beast:define-aspect loc p)
+
+(defun loc/row (entity) (row (loc/p entity)))
+(defun loc/col (entity) (col (loc/p entity)))
+
+
+(defun initialize-loc (rows cols)
+ (setf *locations* (make-array (list rows cols) :initial-element nil)))
+
+(defmethod beast:entity-created :after ((entity loc))
+ (setf (aref *locations* (loc/row entity) (loc/col entity)) entity))
+
+(defmethod beast:entity-destroyed :after ((entity loc))
+ (when (loc/p entity)
+ (setf (aref *locations* (loc/row entity) (loc/col entity)) nil)))
+
+
+(defun move (entity p)
+ (setf (aref *locations* (loc/row entity) (loc/col entity)) nil
+ (loc/p entity) p
+ (aref *locations* (loc/row entity) (loc/col entity)) entity))
+
+(defun loc (p)
+ (aref *locations* (row p) (col p)))
+
+(defun loc< (e1 e2)
+ (p< (loc/p e1) (loc/p e2)))
+
+
+;;;; Other Aspects ------------------------------------------------------------
+(beast:define-aspect living (hp :initform 200))
+(beast:define-aspect fighter (attack-power :initform 3))
+(beast:define-aspect renderable (glyph))
+
+
+;;;; Entities -----------------------------------------------------------------
+(defvar *dead* nil)
+
+(beast:define-entity elf (loc living fighter renderable))
+(beast:define-entity goblin (loc living fighter renderable))
+
+(defmethod print-object ((o elf) s)
+ (print-unreadable-object (o s :type t)
+ (format s "~A ~D" (loc/p o) (living/hp o))))
+
+(defmethod print-object ((o goblin) s)
+ (print-unreadable-object (o s :type t)
+ (format s "~A ~D" (loc/p o) (living/hp o))))
+
+
+(defun create-elf (p)
+ (beast:create-entity 'elf :loc/p p :renderable/glyph #\E))
+
+(defun create-goblin (p)
+ (beast:create-entity 'goblin :loc/p p :renderable/glyph #\G))
+
+
+(defun entities-to-move ()
+ (sort (beast:map-entities #'identity) #'loc<))
+
+(defun enemiesp (e1 e2)
+ (typep e2 (etypecase e1
+ (goblin 'elf)
+ (elf 'goblin))))
+
+(defun targets (entity)
+ (beast:map-entities #'identity (etypecase entity
+ (goblin 'elf)
+ (elf 'goblin))))
+
+(defun attack (attacker defender)
+ (decf (living/hp defender)
+ (fighter/attack-power attacker))
+ (unless (plusp (living/hp defender))
+ (push defender *dead*)
+ (beast:destroy-entity defender)))
+
+
+;;;; Terrain ------------------------------------------------------------------
+(defvar *terrain* nil)
+
+(defun initialize-terrain (rows cols)
+ (setf *terrain* (make-array (list rows cols)
+ :element-type 'character
+ :initial-element #\.)))
+
+
+(defun terrain (p)
+ (aref *terrain* (row p) (col p)))
+
+(defun (setf terrain) (new-value p)
+ (setf (aref *terrain* (row p) (col p)) new-value))
+
+
+(defun passablep (p)
+ (case (terrain p)
+ (#\# nil)
+ (t t)))
+
+
+;;;; World --------------------------------------------------------------------
+(defun openp (p)
+ (and (null (loc p))
+ (passablep p)))
+
+(defun in-bounds-p (p)
+ (array-in-bounds-p *terrain* (row p) (col p)))
+
+(defun open-neighbors (p)
+ (remove-if-not (alexandria:conjoin #'openp #'in-bounds-p)
+ (neighbors p)))
+
+(defun adjacent-enemies (mob)
+ (-<> mob
+ loc/p
+ neighbors
+ (mapcar #'loc <>)
+ (remove nil <>)
+ (remove-if-not (curry #'enemiesp mob) <>)))
+
+(defun adjacent-enemy (mob)
+ (first (sort (adjacent-enemies mob) #'loc<)))
+
+(defun target-squares (unit)
+ (-<> unit
+ targets
+ (mapcan (compose #'open-neighbors #'loc/p) <>)
+ (remove-duplicates <> :test #'=)))
+
+
+(defun step-cost (start from to)
+ ;; We adjust the cost of the first step of our path to account for the
+ ;; bullshit reading order tie breaking (but never enough to send us the wrong
+ ;; way).
+ (if (= from start)
+ (ecase (- to from)
+ (#c(-1 0) 1)
+ (#c(0 -1) 1.1)
+ (#c(0 1) 1.2)
+ (#c(1 0) 1.3))
+ 1))
+
+(defun action (mob)
+ (if-let ((enemy (adjacent-enemy mob)))
+ (values :attack enemy)
+ (iterate
+ (with goals = (target-squares mob))
+ (with start = (loc/p mob))
+ (with best-goal = nil)
+ (with best-path = nil)
+ (with best-cost = nil)
+ (for goal :in goals)
+ (for path = (astar :start start
+ :neighbors #'open-neighbors
+ :goalp (curry #'= goal)
+ :cost (curry #'step-cost start)
+ :limit best-cost
+ :heuristic (curry #'distance goal)
+ :test #'eql))
+ (when path
+ (for cost = (length path))
+ (when (or (null best-path) ; this is the first path
+ (< cost best-cost) ; this is a shorter path
+ (p< goal best-goal)) ; this is a better destination by reading order
+ (setf best-path path
+ best-goal goal
+ best-cost cost)))
+ (finally (return (if best-path
+ (values :move (second best-path))
+ (values :wait)))))))
+
+
+(defun tick-mob (mob)
+ (unless (member mob *dead*)
+ (multiple-value-bind (action target) (action mob)
+ (ecase action
+ (:attack
+ (pr mob 'attacking target)
+ (attack mob target))
+ (:move
+ (pr mob 'moving 'to target)
+ (move mob target))
+ (:wait
+ (pr mob 'waiting))))))
+
+
+(defun tick-world ()
+ (let ((*dead* nil))
+ (map nil #'tick-mob (entities-to-move))))
+
+
+;;;; World Generation ---------------------------------------------------------
+(defun generate-world (lines)
+ (removef lines "" :test #'string=)
+ (beast:clear-entities)
+ (let* ((rows (length lines))
+ (cols (length (first lines))))
+ (initialize-loc rows cols)
+ (initialize-terrain rows cols)
+ (iterate
+ (for line :in lines)
+ (for row :from 0)
+ (iterate
+ (for char :in-string line :with-index col)
+ (for p = (p row col))
+ (case char
+ (#\E (create-elf p))
+ (#\G (create-goblin p))
+ (#\# (setf (terrain p) #\#))
+ (t nil))))))
+
+(defun print-world (&optional path)
+ (iterate
+ (for (char row col) :in-array *terrain*)
+ (for p = (p row col))
+ (for mob = (loc p))
+ (when (zerop col)
+ (terpri))
+ (write-char (cond
+ ((member p path) #\x)
+ (mob (renderable/glyph mob))
+ (t char))))
+ (terpri)
+ (values))
+
+
+(define-problem (2018 15) (data read-lines) ()
+ (generate-world data)
+ (print-world))
--- a/src/2019/day-01.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(defpackage :advent/2019/01 #.cl-user::*advent-use*)
-(in-package :advent/2019/01)
-
-
-(defun fuel-required (module-mass)
- (max 0 (- (floor module-mass 3) 2)))
-
-(defun complete-fuel-required (module-mass)
- (iterate
- (for fuel :first (fuel-required module-mass) :then (fuel-required fuel))
- (summing fuel)
- (until (zerop fuel))))
-
-(define-problem (2019 1) (data read-all) (3464458 5193796)
- (values (summation data :key #'fuel-required)
- (summation data :key #'complete-fuel-required)))
-
--- a/src/2019/day-02.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(defpackage :advent/2019/02 #.cl-user::*advent-use*)
-(in-package :advent/2019/02)
-
-(define-problem (2019 2) (data read-numbers) (3790689 6533)
- (let ((program (fresh-vector data)))
- (flet ((run (a b)
- (setf (aref program 1) a
- (aref program 2) b)
- (advent/intcode:run program)))
- (values
- (run 12 2)
- (iterate
- (for-nested ((a :from 0 :to 99)
- (b :from 0 :to 99)))
- (when (= 19690720 (run a b))
- (return (+ (* 100 a) b))))))))
-
--- a/src/2019/day-03.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,92 +0,0 @@
-(defpackage :advent/2019/03 #.cl-user::*advent-use*)
-(in-package :advent/2019/03)
-
-(defun bounds (grid)
- (multiple-value-bind (bottom top)
- (losh:extrema #'< (alexandria:hash-table-keys grid) :key #'y)
- (multiple-value-bind (left right)
- (losh:extrema #'< (alexandria:hash-table-keys grid) :key #'x)
- (values (x left)
- (x right)
- (y top)
- (y bottom)))))
-
-(defun print-grid (grid)
- (multiple-value-bind (left right top bottom) (bounds grid)
- (iterate
- (for y :from (1+ top) :downto (1- bottom))
- (iterate
- (for x :from (1- left) :to (1+ right))
- (princ (gethash (complex x y) grid #\.)))
- (terpri))))
-
-(defun first-character (string)
- (aref string 0))
-
-(defun parse-path (string)
- (gathering
- (ppcre:do-register-groups
- ((#'first-character direction) (#'parse-integer distance))
- ("([UDLR])(\\d+)" string)
- (gather (cons direction distance)))))
-
-(defun delta (direction)
- (ecase direction
- (#\U #c( 0 1))
- (#\D #c( 0 -1))
- (#\L #c(-1 0))
- (#\R #c( 1 0))))
-
-(defun place-wire (grid path label)
- (iterate
- (with scores = (make-hash-table))
- (with steps = 0)
- (with pos = #c(0 0))
- (for (direction . distance) :in path)
- (for delta = (delta direction))
- (iterate
- (repeat distance)
- (incf pos delta)
- (incf steps)
- (for cur = (gethash pos grid))
- (cond ((null cur) (setf (gethash pos grid) label ; never seen anything
- (gethash pos scores) steps))
- ((char= cur label)) ; already seen
- ((char= cur #\X)) ; already seen
- (t (setf (gethash pos grid) #\X ; seen the other wire
- (gethash pos scores) steps))))
- (finally (return scores))))
-
-(defun find-intersections (grid)
- (iterate (for (k v) :in-hashtable grid)
- (when (eql #\X v) (collect k))))
-
-(defun make-grid ()
- (let-result (grid (make-hash-table))
- (setf (gethash #c(0 0) grid) #\o)))
-
-(define-problem (2019 3) (data read-lines) (5357 101956)
- (let* ((path1 (parse-path (first data)))
- (path2 (parse-path (second data)))
- (grid (make-grid))
- (scores1 (place-wire grid path1 #\1))
- (scores2 (place-wire grid path2 #\2))
- (intersections (find-intersections grid)))
- (flet ((intersection-cost (point)
- (+ (gethash point scores1)
- (gethash point scores2))))
- (values
- (alexandria:extremum (mapcar #'manhattan-distance intersections) #'<)
- (alexandria:extremum (mapcar #'intersection-cost intersections) #'<)))))
-
-;; (run '("R8,U5,L5,D3" "U7,R6,D4,L4"))
-;; (run '(
-;; "R75,D30,R83,U83,L12,D49,R71,U7,L72"
-;; "U62,R66,U55,R34,D71,R55,D58,R83"
-;; ))
-
-;; (run '(
-;; "R98,U47,R26,D63,R33,U87,L62,D20,R33,U53,R51"
-;; "U98,R91,D20,R16,D67,R40,U7,R15,U6,R7"
-
-;; ))
--- a/src/2019/day-04.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,32 +0,0 @@
-(defpackage :advent/2019/04 #.cl-user::*advent-use*)
-(in-package :advent/2019/04)
-
-(defun nondecreasing-digits-p (n)
- (iterate
- (for (a b) :on (digits n))
- (while b)
- (always (<= a b))))
-
-(defun contains-duplicate-digit-p (n)
- (iterate
- (for (a b) :on (digits n))
- (thereis (eql a b))))
-
-(defun contains-offset-duplicate-digit-p (n)
- (iterate
- (for (a b c d) :on (cons nil (digits n)))
- (while c)
- (thereis (and (eql b c)
- (not (eql a b))
- (not (eql c d))))))
-
-(define-problem (2019 4) (data read-line) ()
- (destructuring-bind (lo hi) (mapcar #'parse-integer (str:split #\- data))
- (iterate
- (for i :from lo :to hi)
- (for nondecreasing = (nondecreasing-digits-p i))
- (for duplicate = (contains-duplicate-digit-p i))
- (for offset-duplicate = (contains-offset-duplicate-digit-p i))
- (counting (and nondecreasing duplicate) :into part1)
- (counting (and nondecreasing offset-duplicate) :into part2)
- (returning part1 part2))))
--- a/src/2019/day-05.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(defpackage :advent/2019/05 #.cl-user::*advent-use*)
-(in-package :advent/2019/05)
-
-(define-problem (2019 5) (data read-numbers) (14522484 4)
- (values
- (car (last (gathering
- (advent/intcode:run data :input (constantly 1) :output #'gather))))
- (car (gathering
- (advent/intcode:run data :input (constantly 5) :output #'gather)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-01.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,17 @@
+(defpackage :advent/2019/01 #.cl-user::*advent-use*)
+(in-package :advent/2019/01)
+
+
+(defun fuel-required (module-mass)
+ (max 0 (- (floor module-mass 3) 2)))
+
+(defun complete-fuel-required (module-mass)
+ (iterate
+ (for fuel :first (fuel-required module-mass) :then (fuel-required fuel))
+ (summing fuel)
+ (until (zerop fuel))))
+
+(define-problem (2019 1) (data read-all) (3464458 5193796)
+ (values (summation data :key #'fuel-required)
+ (summation data :key #'complete-fuel-required)))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-02.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,17 @@
+(defpackage :advent/2019/02 #.cl-user::*advent-use*)
+(in-package :advent/2019/02)
+
+(define-problem (2019 2) (data read-numbers) (3790689 6533)
+ (let ((program (fresh-vector data)))
+ (flet ((run (a b)
+ (setf (aref program 1) a
+ (aref program 2) b)
+ (advent/intcode:run program)))
+ (values
+ (run 12 2)
+ (iterate
+ (for-nested ((a :from 0 :to 99)
+ (b :from 0 :to 99)))
+ (when (= 19690720 (run a b))
+ (return (+ (* 100 a) b))))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-03.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,92 @@
+(defpackage :advent/2019/03 #.cl-user::*advent-use*)
+(in-package :advent/2019/03)
+
+(defun bounds (grid)
+ (multiple-value-bind (bottom top)
+ (losh:extrema #'< (alexandria:hash-table-keys grid) :key #'y)
+ (multiple-value-bind (left right)
+ (losh:extrema #'< (alexandria:hash-table-keys grid) :key #'x)
+ (values (x left)
+ (x right)
+ (y top)
+ (y bottom)))))
+
+(defun print-grid (grid)
+ (multiple-value-bind (left right top bottom) (bounds grid)
+ (iterate
+ (for y :from (1+ top) :downto (1- bottom))
+ (iterate
+ (for x :from (1- left) :to (1+ right))
+ (princ (gethash (complex x y) grid #\.)))
+ (terpri))))
+
+(defun first-character (string)
+ (aref string 0))
+
+(defun parse-path (string)
+ (gathering
+ (ppcre:do-register-groups
+ ((#'first-character direction) (#'parse-integer distance))
+ ("([UDLR])(\\d+)" string)
+ (gather (cons direction distance)))))
+
+(defun delta (direction)
+ (ecase direction
+ (#\U #c( 0 1))
+ (#\D #c( 0 -1))
+ (#\L #c(-1 0))
+ (#\R #c( 1 0))))
+
+(defun place-wire (grid path label)
+ (iterate
+ (with scores = (make-hash-table))
+ (with steps = 0)
+ (with pos = #c(0 0))
+ (for (direction . distance) :in path)
+ (for delta = (delta direction))
+ (iterate
+ (repeat distance)
+ (incf pos delta)
+ (incf steps)
+ (for cur = (gethash pos grid))
+ (cond ((null cur) (setf (gethash pos grid) label ; never seen anything
+ (gethash pos scores) steps))
+ ((char= cur label)) ; already seen
+ ((char= cur #\X)) ; already seen
+ (t (setf (gethash pos grid) #\X ; seen the other wire
+ (gethash pos scores) steps))))
+ (finally (return scores))))
+
+(defun find-intersections (grid)
+ (iterate (for (k v) :in-hashtable grid)
+ (when (eql #\X v) (collect k))))
+
+(defun make-grid ()
+ (let-result (grid (make-hash-table))
+ (setf (gethash #c(0 0) grid) #\o)))
+
+(define-problem (2019 3) (data read-lines) (5357 101956)
+ (let* ((path1 (parse-path (first data)))
+ (path2 (parse-path (second data)))
+ (grid (make-grid))
+ (scores1 (place-wire grid path1 #\1))
+ (scores2 (place-wire grid path2 #\2))
+ (intersections (find-intersections grid)))
+ (flet ((intersection-cost (point)
+ (+ (gethash point scores1)
+ (gethash point scores2))))
+ (values
+ (alexandria:extremum (mapcar #'manhattan-distance intersections) #'<)
+ (alexandria:extremum (mapcar #'intersection-cost intersections) #'<)))))
+
+;; (run '("R8,U5,L5,D3" "U7,R6,D4,L4"))
+;; (run '(
+;; "R75,D30,R83,U83,L12,D49,R71,U7,L72"
+;; "U62,R66,U55,R34,D71,R55,D58,R83"
+;; ))
+
+;; (run '(
+;; "R98,U47,R26,D63,R33,U87,L62,D20,R33,U53,R51"
+;; "U98,R91,D20,R16,D67,R40,U7,R15,U6,R7"
+
+;; ))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-04.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,32 @@
+(defpackage :advent/2019/04 #.cl-user::*advent-use*)
+(in-package :advent/2019/04)
+
+(defun nondecreasing-digits-p (n)
+ (iterate
+ (for (a b) :on (digits n))
+ (while b)
+ (always (<= a b))))
+
+(defun contains-duplicate-digit-p (n)
+ (iterate
+ (for (a b) :on (digits n))
+ (thereis (eql a b))))
+
+(defun contains-offset-duplicate-digit-p (n)
+ (iterate
+ (for (a b c d) :on (cons nil (digits n)))
+ (while c)
+ (thereis (and (eql b c)
+ (not (eql a b))
+ (not (eql c d))))))
+
+(define-problem (2019 4) (data read-line) ()
+ (destructuring-bind (lo hi) (mapcar #'parse-integer (str:split #\- data))
+ (iterate
+ (for i :from lo :to hi)
+ (for nondecreasing = (nondecreasing-digits-p i))
+ (for duplicate = (contains-duplicate-digit-p i))
+ (for offset-duplicate = (contains-offset-duplicate-digit-p i))
+ (counting (and nondecreasing duplicate) :into part1)
+ (counting (and nondecreasing offset-duplicate) :into part2)
+ (returning part1 part2))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/days/day-05.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,9 @@
+(defpackage :advent/2019/05 #.cl-user::*advent-use*)
+(in-package :advent/2019/05)
+
+(define-problem (2019 5) (data read-numbers) (14522484 4)
+ (values
+ (car (last (gathering
+ (advent/intcode:run data :input (constantly 1) :output #'gather))))
+ (car (gathering
+ (advent/intcode:run data :input (constantly 5) :output #'gather)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2019/intcode.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -0,0 +1,196 @@
+(defpackage :advent/intcode
+ #.cl-user::*advent-use*
+ (:shadow :step :trace)
+ (:export :init :step :run))
+
+(in-package :advent/intcode)
+
+
+;;;; Data Structures ----------------------------------------------------------
+(defclass* machine ()
+ ((pc :type '(integer 0) :initform 0)
+ (memory :type 'vector)
+ (input :type 'function)
+ (output :type 'function)))
+
+(define-with-macro machine pc memory input output)
+
+
+(defclass* operation ()
+ ((opcode :type (integer 0))
+ (name :type 'symbol)
+ (size :type '(integer 1))
+ (parameters :type 'list)
+ (perform :type 'function)))
+
+(defun perform-operation (opcode parameter-modes machine)
+ (funcall (perform (gethash opcode *operations*))
+ parameter-modes machine))
+
+
+;;;; Opcode Definition --------------------------------------------------------
+(defun retrieve (machine parameter-mode operand)
+ (ecase parameter-mode
+ (0 (aref (memory machine) operand))
+ (1 operand)))
+
+(defmacro define-opcode ((opcode name) parameters &body body)
+ ;; Note that (confusingly) output parameters don't use the same addressing
+ ;; scheme as input parameters. For example: in the instruction 00002,1,2,99
+ ;; all the parameter modes are 0, which means "look up the value at address
+ ;; N to get the parameter". But for the destination (99) you *don't* look up
+ ;; the value at 99 to find the destination address, you just store directly
+ ;; into 99. Effectively they're treated as if they were in parameter mode
+ ;; 1 (immediate mode). So we need to handle output parameters specially.
+ ;;
+ ;; Sigh.
+ (setf parameters (mapcar (lambda (param)
+ (if (symbolp param)
+ `(,param in)
+ param))
+ parameters))
+ (let ((function-name (alexandria:symbolicate 'op- name)))
+ (alexandria:with-gensyms (machine pmodes pm pms)
+ `(progn
+ (defun ,function-name (,pmodes ,machine)
+ (declare (ignorable ,pmodes))
+ (flet ((pop-mode ()
+ (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10)
+ (setf ,pmodes ,pms)
+ ,pm)))
+ (with-machine (,machine)
+ (let (,@(iterate
+ (for (param kind) :in parameters)
+ (for offset :from 0)
+ (collect
+ (ecase kind
+ (in `(,param (retrieve ,machine
+ (pop-mode)
+ (aref memory (+ pc ,offset)))))
+ (out `(,param (progn
+ (pop-mode)
+ (aref memory (+ pc ,offset)))))))))
+ (incf pc ,(length parameters))
+ ,@body))))
+ (setf (gethash ,opcode *operations*)
+ (make-instance 'operation
+ :opcode ,opcode
+ :name ',name
+ :size ,(1+ (length parameters))
+ :parameters ',parameters
+ :perform #',function-name))
+ ',function-name))))
+
+
+;;;; Opcodes ------------------------------------------------------------------
+(defparameter *operations* (make-hash-table))
+
+(define-opcode (99 HLT) ()
+ :halt)
+
+(define-opcode (1 ADD) (x y (dest out))
+ (setf (aref memory dest) (+ x y)))
+
+(define-opcode (2 MUL) (x y (dest out))
+ (setf (aref memory dest) (* x y)))
+
+(define-opcode (3 INP) ((dest out))
+ (setf (aref memory dest) (funcall input)))
+
+(define-opcode (4 OUT) (val)
+ (funcall output val))
+
+(define-opcode (5 JPT) (x addr)
+ (unless (zerop x)
+ (setf pc addr)))
+
+(define-opcode (6 JPF) (x addr)
+ (when (zerop x)
+ (setf pc addr)))
+
+(define-opcode (7 LES) (x y (dest out))
+ (setf (aref memory dest)
+ (if (< x y) 1 0)))
+
+(define-opcode (8 EQL) (x y (dest out))
+ (setf (aref memory dest)
+ (if (= x y) 1 0)))
+
+
+;;;; Disassembly --------------------------------------------------------------
+(defun parse-op (n)
+ (multiple-value-bind (parameter-modes opcode) (truncate n 100)
+ (values opcode parameter-modes)))
+
+(defun disassemble-operation (program address)
+ (multiple-value-bind (opcode parameter-modes)
+ (parse-op (aref program address))
+ (let ((op (gethash opcode *operations*)))
+ (if op
+ (values
+ `(,(name op)
+ ,@(iterate
+ (for (param kind) :in (parameters op))
+ (for value :in-vector program :from (1+ address))
+ (for mode = (mod parameter-modes 10))
+ (collect `(,param ,(ecase kind
+ (in (ecase mode
+ (0 (vector value))
+ (1 value)))
+ (out value))))
+ (setf parameter-modes (truncate parameter-modes 10))))
+ (size op))
+ (values `(data ,(aref program address)) 1)))))
+
+(defun disassemble-program (program &key (start 0) (limit nil))
+ (iterate
+ (when limit
+ (if (zerop limit)
+ (return)
+ (decf limit)))
+ (with address = start)
+ (with bound = (length program))
+ (while (< address bound))
+ (for (values instruction size) = (disassemble-operation program address))
+ (for end = (+ address size))
+ (when (> end bound) ; hack to handle trailing data that looks instructionish
+ (setf instruction `(data ,(aref program address))
+ size 1
+ end (1+ address)))
+ (for bytes = (coerce (subseq program address end) 'list))
+ (format t "~4D | ~{~5D~^ ~} ~36T| ~{~A~^ ~}~%" address bytes instruction)
+ (incf address size)))
+
+
+;;;; Running ------------------------------------------------------------------
+(defun init (program &key input output)
+ (make-instance 'machine
+ :memory (fresh-vector program)
+ :input (or input #'read)
+ :output (or output #'print)))
+
+(defun step (machine &key trace)
+ (with-machine (machine)
+ (when trace
+ (disassemble-program (memory machine) :start pc :limit 1))
+ (multiple-value-bind (opcode parameter-modes) (parse-op (aref memory pc))
+ (incf pc)
+ (perform-operation opcode parameter-modes machine))))
+
+(defun run (program &key input output trace)
+ (iterate
+ (with machine = (init program :input input :output output))
+ (case (step machine :trace trace)
+ (:halt (return (aref (memory machine) 0))))))
+
+
+;; #; Scratch --------------------------------------------------------------------
+
+;; (defparameter *m* (init '(1101 100 -1 4 99)))
+;; (dump *m*)
+;; (disassemble-operation (memory *m*) 0)
+;; (disassemble-program (memory *m*))
+;; (step *m*)
+
+;; (run #( 3 12 6 12 15 1 13 14 13 4 13 99 -1 0 1 9)
+;; :input #'read :output #'print)
--- a/src/intcode.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,196 +0,0 @@
-(defpackage :advent/intcode
- #.cl-user::*advent-use*
- (:shadow :step :trace)
- (:export :init :step :run))
-
-(in-package :advent/intcode)
-
-
-;;;; Data Structures ----------------------------------------------------------
-(defclass* machine ()
- ((pc :type '(integer 0) :initform 0)
- (memory :type 'vector)
- (input :type 'function)
- (output :type 'function)))
-
-(define-with-macro machine pc memory input output)
-
-
-(defclass* operation ()
- ((opcode :type (integer 0))
- (name :type 'symbol)
- (size :type '(integer 1))
- (parameters :type 'list)
- (perform :type 'function)))
-
-(defun perform-operation (opcode parameter-modes machine)
- (funcall (perform (gethash opcode *operations*))
- parameter-modes machine))
-
-
-;;;; Opcode Definition --------------------------------------------------------
-(defun retrieve (machine parameter-mode operand)
- (ecase parameter-mode
- (0 (aref (memory machine) operand))
- (1 operand)))
-
-(defmacro define-opcode ((opcode name) parameters &body body)
- ;; Note that (confusingly) output parameters don't use the same addressing
- ;; scheme as input parameters. For example: in the instruction 00002,1,2,99
- ;; all the parameter modes are 0, which means "look up the value at address
- ;; N to get the parameter". But for the destination (99) you *don't* look up
- ;; the value at 99 to find the destination address, you just store directly
- ;; into 99. Effectively they're treated as if they were in parameter mode
- ;; 1 (immediate mode). So we need to handle output parameters specially.
- ;;
- ;; Sigh.
- (setf parameters (mapcar (lambda (param)
- (if (symbolp param)
- `(,param in)
- param))
- parameters))
- (let ((function-name (alexandria:symbolicate 'op- name)))
- (alexandria:with-gensyms (machine pmodes pm pms)
- `(progn
- (defun ,function-name (,pmodes ,machine)
- (declare (ignorable ,pmodes))
- (flet ((pop-mode ()
- (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10)
- (setf ,pmodes ,pms)
- ,pm)))
- (with-machine (,machine)
- (let (,@(iterate
- (for (param kind) :in parameters)
- (for offset :from 0)
- (collect
- (ecase kind
- (in `(,param (retrieve ,machine
- (pop-mode)
- (aref memory (+ pc ,offset)))))
- (out `(,param (progn
- (pop-mode)
- (aref memory (+ pc ,offset)))))))))
- (incf pc ,(length parameters))
- ,@body))))
- (setf (gethash ,opcode *operations*)
- (make-instance 'operation
- :opcode ,opcode
- :name ',name
- :size ,(1+ (length parameters))
- :parameters ',parameters
- :perform #',function-name))
- ',function-name))))
-
-
-;;;; Opcodes ------------------------------------------------------------------
-(defparameter *operations* (make-hash-table))
-
-(define-opcode (99 HLT) ()
- :halt)
-
-(define-opcode (1 ADD) (x y (dest out))
- (setf (aref memory dest) (+ x y)))
-
-(define-opcode (2 MUL) (x y (dest out))
- (setf (aref memory dest) (* x y)))
-
-(define-opcode (3 INP) ((dest out))
- (setf (aref memory dest) (funcall input)))
-
-(define-opcode (4 OUT) (val)
- (funcall output val))
-
-(define-opcode (5 JPT) (x addr)
- (unless (zerop x)
- (setf pc addr)))
-
-(define-opcode (6 JPF) (x addr)
- (when (zerop x)
- (setf pc addr)))
-
-(define-opcode (7 LES) (x y (dest out))
- (setf (aref memory dest)
- (if (< x y) 1 0)))
-
-(define-opcode (8 EQL) (x y (dest out))
- (setf (aref memory dest)
- (if (= x y) 1 0)))
-
-
-;;;; Disassembly --------------------------------------------------------------
-(defun parse-op (n)
- (multiple-value-bind (parameter-modes opcode) (truncate n 100)
- (values opcode parameter-modes)))
-
-(defun disassemble-operation (program address)
- (multiple-value-bind (opcode parameter-modes)
- (parse-op (aref program address))
- (let ((op (gethash opcode *operations*)))
- (if op
- (values
- `(,(name op)
- ,@(iterate
- (for (param kind) :in (parameters op))
- (for value :in-vector program :from (1+ address))
- (for mode = (mod parameter-modes 10))
- (collect `(,param ,(ecase kind
- (in (ecase mode
- (0 (vector value))
- (1 value)))
- (out value))))
- (setf parameter-modes (truncate parameter-modes 10))))
- (size op))
- (values `(data ,(aref program address)) 1)))))
-
-(defun disassemble-program (program &key (start 0) (limit nil))
- (iterate
- (when limit
- (if (zerop limit)
- (return)
- (decf limit)))
- (with address = start)
- (with bound = (length program))
- (while (< address bound))
- (for (values instruction size) = (disassemble-operation program address))
- (for end = (+ address size))
- (when (> end bound) ; hack to handle trailing data that looks instructionish
- (setf instruction `(data ,(aref program address))
- size 1
- end (1+ address)))
- (for bytes = (coerce (subseq program address end) 'list))
- (format t "~4D | ~{~5D~^ ~} ~36T| ~{~A~^ ~}~%" address bytes instruction)
- (incf address size)))
-
-
-;;;; Running ------------------------------------------------------------------
-(defun init (program &key input output)
- (make-instance 'machine
- :memory (fresh-vector program)
- :input (or input #'read)
- :output (or output #'print)))
-
-(defun step (machine &key trace)
- (with-machine (machine)
- (when trace
- (disassemble-program (memory machine) :start pc :limit 1))
- (multiple-value-bind (opcode parameter-modes) (parse-op (aref memory pc))
- (incf pc)
- (perform-operation opcode parameter-modes machine))))
-
-(defun run (program &key input output trace)
- (iterate
- (with machine = (init program :input input :output output))
- (case (step machine :trace trace)
- (:halt (return (aref (memory machine) 0))))))
-
-
-#; Scratch --------------------------------------------------------------------
-
-(defparameter *m* (init '(1101 100 -1 4 99)))
-(dump *m*)
-(disassemble-operation (memory *m*) 0)
-(disassemble-program (memory *m*))
-(step *m*)
-
-(run #( 3 12 6 12 15 1 13 14 13 4 13 99 -1 0 1 9)
- :input #'read :output #'print)
--- a/src/number-spiral.lisp Thu Dec 05 19:36:23 2019 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,90 +0,0 @@
-(defpackage :advent/spiral
- (:use :cl :losh :iterate :advent.quickutils)
- (:export :number-coordinates))
-
-(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))))
--- a/src/utils.lisp Thu Dec 05 19:36:23 2019 -0500
+++ b/src/utils.lisp Thu Dec 05 20:45:46 2019 -0500
@@ -452,6 +452,14 @@
,@body
,symbol))
+(defmacro let-complex (bindings &body body)
+ `(let* (,@(iterate (for (x y val) :in bindings)
+ (for v = (gensym))
+ (collect `(,v ,val))
+ (collect `(,x (realpart ,v)))
+ (collect `(,y (imagpart ,v)))))
+ ,@body))
+
;;;; A* Search ----------------------------------------------------------------
(defstruct path