--- a/src/2018/main.lisp Sat Dec 01 19:30:27 2018 -0500
+++ b/src/2018/main.lisp Tue Dec 04 19:26:33 2018 -0500
@@ -1,4 +1,5 @@
(in-package :advent)
+(named-readtables:in-readtable :interpol-syntax)
;;;; Problems -----------------------------------------------------------------
(define-problem (2018 1 1) (data read-all-from-file)
@@ -13,3 +14,111 @@
(if (hset-contains-p seen frequency)
(return frequency)
(hset-insert! seen frequency))))
+
+
+(define-problem (2018 2 1) (data read-lines-from-file)
+ (let* ((freqs (mapcar #'frequencies data))
+ (counts (mapcar #'hash-table-values freqs)))
+ (* (count 2 counts :test #'member)
+ (count 3 counts :test #'member))))
+
+(define-problem (2018 2 2) (data read-lines-from-file)
+ ;; 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))))))
+
+
+(defstruct claim id left right top bottom)
+
+(define-problem (2018 3) (data read-lines-from-file)
+ (labels ((parse-claim (line)
+ (ppcre:register-groups-bind
+ ((#'parse-integer id col row width height))
+ (#?/#(\d+) @ (\d+),(\d+): (\d+)x(\d+)/ line)
+ (make-claim :id id
+ :left col
+ :top row
+ :right (+ col width)
+ :bottom (+ row height))))
+ (claims-intersect-p (claim1 claim2)
+ (not (or (<= (claim-right claim2) (claim-left claim1))
+ (<= (claim-right claim1) (claim-left claim2))
+ (>= (claim-top claim2) (claim-bottom claim1))
+ (>= (claim-top claim1) (claim-bottom claim2))))))
+ (let ((claims (mapcar #'parse-claim data))
+ (fabric (make-array (list 1000 1000) :initial-element 0)))
+ (dolist (claim claims)
+ (do-range ((row (claim-top claim) (claim-bottom claim))
+ (col (claim-left claim) (claim-right claim)))
+ (incf (aref fabric row col))))
+ (values
+ (iterate (for uses :in-array fabric)
+ (counting (> uses 1)))
+ (claim-id (first (unique claims :test #'claims-intersect-p)))))))
+
+
+(define-problem (2018 4) (data read-lines-from-file)
+ ;; 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.
+ (labels ((parse-line (line)
+ "Parse `line` into `(minute :event id?)`"
+ (ppcre:register-groups-bind
+ ((#'parse-integer minute) event)
+ (#?/\[\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))
+ (#?/Guard #(\d+) begins shift/ event)
+ (list :guard id)))))))
+ (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)))))
+ (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)))))
+ (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/vendor/quickutils.lisp Sat Dec 01 19:30:27 2018 -0500
+++ b/vendor/quickutils.lisp Tue Dec 04 19:26:33 2018 -0500
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:EXTREMUM :ENSURE-GETHASH :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :HASH-TABLE-KEYS :HASH-TABLE-VALUES :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "ADVENT.QUICKUTILS")
@@ -13,7 +13,15 @@
(in-package "ADVENT.QUICKUTILS")
(when (boundp '*utilities*)
- (setf *utilities* (union *utilities* '(:ENSURE-FUNCTION :EXTREMUM :ENSURE-GETHASH :MAKE-GENSYM-LIST :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+ (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :MAPHASH-KEYS :HASH-TABLE-KEYS :MAPHASH-VALUES :HASH-TABLE-VALUES :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun make-gensym-list (length &optional (x "G"))
+ "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
+using the second (optional, defaulting to `\"G\"`) argument."
+ (let ((g (if (typep x '(integer 0)) x (string x))))
+ (loop repeat length
+ collect (gensym g))))
+ ) ; eval-when
(eval-when (:compile-toplevel :load-toplevel :execute)
;;; To propagate return type and allow the compiler to eliminate the IF when
;;; it is known if the argument is function or not.
@@ -30,6 +38,88 @@
(fdefinition function-designator)))
) ; eval-when
+ (defun compose (function &rest more-functions)
+ "Returns a function composed of `function` and `more-functions` that applies its ;
+arguments to to each in turn, starting from the rightmost of `more-functions`,
+and then calling the next one with the primary value of the last."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (reduce (lambda (f g)
+ (let ((f (ensure-function f))
+ (g (ensure-function g)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ (funcall f (apply g arguments)))))
+ more-functions
+ :initial-value function))
+
+ (define-compiler-macro compose (function &rest more-functions)
+ (labels ((compose-1 (funs)
+ (if (cdr funs)
+ `(funcall ,(car funs) ,(compose-1 (cdr funs)))
+ `(apply ,(car funs) arguments))))
+ (let* ((args (cons function more-functions))
+ (funs (make-gensym-list (length args) "COMPOSE")))
+ `(let ,(loop for f in funs for arg in args
+ collect `(,f (ensure-function ,arg)))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ ,(compose-1 funs))))))
+
+
+ (defun copy-hash-table (table &key key test size
+ rehash-size rehash-threshold)
+ "Returns a copy of hash table `table`, with the same keys and values
+as the `table`. The copy has the same properties as the original, unless
+overridden by the keyword arguments.
+
+Before each of the original values is set into the new hash-table, `key`
+is invoked on the value. As `key` defaults to `cl:identity`, a shallow
+copy is returned by default."
+ (setf key (or key 'identity))
+ (setf test (or test (hash-table-test table)))
+ (setf size (or size (hash-table-size table)))
+ (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
+ (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
+ (let ((copy (make-hash-table :test test :size size
+ :rehash-size rehash-size
+ :rehash-threshold rehash-threshold)))
+ (maphash (lambda (k v)
+ (setf (gethash k copy) (funcall key v)))
+ table)
+ copy))
+
+
+ (defun curry (function &rest arguments)
+ "Returns a function that applies `arguments` and the arguments
+it is called with to `function`."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((fn (ensure-function function)))
+ (lambda (&rest more)
+ (declare (dynamic-extent more))
+ ;; Using M-V-C we don't need to append the arguments.
+ (multiple-value-call fn (values-list arguments) (values-list more)))))
+
+ (define-compiler-macro curry (function &rest arguments)
+ (let ((curries (make-gensym-list (length arguments) "CURRY"))
+ (fun (gensym "FUN")))
+ `(let ((,fun (ensure-function ,function))
+ ,@(mapcar #'list curries arguments))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest more)
+ (apply ,fun ,@curries more)))))
+
+
+ (defmacro ensure-gethash (key hash-table &optional default)
+ "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
+under key before returning it. Secondary return value is true if key was
+already in the table."
+ `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
+ (if ok
+ (values value ok)
+ (values (setf (gethash ,key ,hash-table) ,default) nil))))
+
+
(defun extremum (sequence predicate &key key (start 0) end)
"Returns the element of `sequence` that would appear first if the subsequence
bounded by `start` and `end` was sorted using `predicate` and `key`.
@@ -74,84 +164,40 @@
:end end)))))
- (defmacro ensure-gethash (key hash-table &optional default)
- "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
-under key before returning it. Secondary return value is true if key was
-already in the table."
- `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
- (if ok
- (values value ok)
- (values (setf (gethash ,key ,hash-table) ,default) nil))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun make-gensym-list (length &optional (x "G"))
- "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
-using the second (optional, defaulting to `\"G\"`) argument."
- (let ((g (if (typep x '(integer 0)) x (string x))))
- (loop repeat length
- collect (gensym g))))
- ) ; eval-when
-
- (defun compose (function &rest more-functions)
- "Returns a function composed of `function` and `more-functions` that applies its ;
-arguments to to each in turn, starting from the rightmost of `more-functions`,
-and then calling the next one with the primary value of the last."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (reduce (lambda (f g)
- (let ((f (ensure-function f))
- (g (ensure-function g)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- (funcall f (apply g arguments)))))
- more-functions
- :initial-value function))
-
- (define-compiler-macro compose (function &rest more-functions)
- (labels ((compose-1 (funs)
- (if (cdr funs)
- `(funcall ,(car funs) ,(compose-1 (cdr funs)))
- `(apply ,(car funs) arguments))))
- (let* ((args (cons function more-functions))
- (funs (make-gensym-list (length args) "COMPOSE")))
- `(let ,(loop for f in funs for arg in args
- collect `(,f (ensure-function ,arg)))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- ,(compose-1 funs))))))
+ (declaim (inline maphash-keys))
+ (defun maphash-keys (function table)
+ "Like `maphash`, but calls `function` with each key in the hash table `table`."
+ (maphash (lambda (k v)
+ (declare (ignore v))
+ (funcall function k))
+ table))
- (defun curry (function &rest arguments)
- "Returns a function that applies `arguments` and the arguments
-it is called with to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- ;; Using M-V-C we don't need to append the arguments.
- (multiple-value-call fn (values-list arguments) (values-list more)))))
-
- (define-compiler-macro curry (function &rest arguments)
- (let ((curries (make-gensym-list (length arguments) "CURRY"))
- (fun (gensym "FUN")))
- `(let ((,fun (ensure-function ,function))
- ,@(mapcar #'list curries arguments))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest more)
- (apply ,fun ,@curries more)))))
+ (defun hash-table-keys (table)
+ "Returns a list containing the keys of hash table `table`."
+ (let ((keys nil))
+ (maphash-keys (lambda (k)
+ (push k keys))
+ table)
+ keys))
- (defun ensure-keyword (x)
- "Ensure that a keyword is returned for the string designator `x`."
- (values (intern (string x) :keyword)))
+ (declaim (inline maphash-values))
+ (defun maphash-values (function table)
+ "Like `maphash`, but calls `function` with each value in the hash table `table`."
+ (maphash (lambda (k v)
+ (declare (ignore k))
+ (funcall function v))
+ table))
- (defun range (start end &key (step 1) (key 'identity))
- "Return the list of numbers `n` such that `start <= n < end` and
-`n = start + k*step` for suitable integers `k`. If a function `key` is
-provided, then apply it to each number."
- (assert (<= start end))
- (loop :for i :from start :below end :by step :collecting (funcall key i)))
+ (defun hash-table-values (table)
+ "Returns a list containing the values of hash table `table`."
+ (let ((values nil))
+ (maphash-values (lambda (v)
+ (push v values))
+ table)
+ values))
(defun rcurry (function &rest arguments)
@@ -272,6 +318,6 @@
(values (intern (apply #'mkstr args))))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(extremum ensure-gethash compose curry ensure-keyword range rcurry read-file-into-string symb)))
+ (export '(compose copy-hash-table curry ensure-gethash extremum hash-table-keys hash-table-values rcurry read-file-into-string symb)))
;;;; END OF quickutils.lisp ;;;;