# HG changeset patch # User Steve Losh # Date 1543969593 18000 # Node ID e22f6a54b6d5da300683ac7d12327bfc8be1cf89 # Parent 66e86b59fc60b81d3c64b5b4a6548dbb4020604f Catch up to day 4 diff -r 66e86b59fc60 -r e22f6a54b6d5 src/2018/main.lisp --- 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)))))) diff -r 66e86b59fc60 -r e22f6a54b6d5 src/utils.lisp --- a/src/utils.lisp Sat Dec 01 19:30:27 2018 -0500 +++ b/src/utils.lisp Tue Dec 04 19:26:33 2018 -0500 @@ -66,3 +66,54 @@ (iterate (for (k v) :in-hashtable h1) (always (funcall test v (gethash k h2)))))) +(defun hamming-distance (sequence1 sequence2 &key (test #'eql)) + "Return the Hamming distance between `sequence1` and `sequence2`." + ;; todo assert length=? + (let ((result 0)) + (map nil (lambda (x y) + (unless (funcall test x y) + (incf result))) + sequence1 + sequence2) + result)) + +(defun unique (list &key (test #'eql)) + "Return a fresh list of the unique elements in `LIST`. + + This differs from REMOVE-DUPLICATES in that *all* duplicate elements will be + removed, not just all-but-the-last. + + This is O(n²). + + Example: + + (remove-duplicates '(3 1 3 2 3)) + ; => (1 2 3) + + (unique '(3 1 3 2 3)) + ; => (1 2) + + " + (iterate + (for a :in list) + (for i :from 0) + (unless (iterate (for b :in list) + (for j :from 0) + (unless (= i j) + (thereis (funcall test a b)))) + (collect a)))) + +(defun extremum+ (sequence predicate) + "Like ALEXANDRIA:EXTREMUM but also return the position as a second value." + (iterate + (with value = nil) + (with position = nil) + (for i :from 0) + (for v :in-whatever sequence) + (if-first-time + (setf value v + position i) + (when (funcall predicate v value) + (setf value v + position i))) + (finally (return (values value position))))) diff -r 66e86b59fc60 -r e22f6a54b6d5 vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Sat Dec 01 19:30:27 2018 -0500 +++ b/vendor/make-quickutils.lisp Tue Dec 04 19:26:33 2018 -0500 @@ -4,12 +4,13 @@ "quickutils.lisp" :utilities '( - :extremum + :compose + :copy-hash-table + :curry :ensure-gethash - :compose - :curry - :ensure-keyword - :range + :extremum + :hash-table-keys + :hash-table-values :rcurry :read-file-into-string :symb diff -r 66e86b59fc60 -r e22f6a54b6d5 vendor/quickutils.lisp --- 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 ;;;;