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