388494359561

Clean up 2017
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 01 Dec 2018 16:33:14 -0500
parents ff5234e0e329
children d3799236a70d
branches/tags (none)
files advent.asd src/2017/main.lisp src/2018/main.lisp src/utils.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/advent.asd	Sat Dec 01 15:26:07 2018 -0500
+++ b/advent.asd	Sat Dec 01 16:33:14 2018 -0500
@@ -13,5 +13,9 @@
                              (:file "quickutils")))
                (:file "package")
                (:module "src" :serial t
-                :components ((:module "2018" :serial t
+                :components ((:file "utils")
+                             (:module "2017" :serial t
+                              :components ((:file "number-spiral")
+                                           (:file "main")))
+                             (:module "2018" :serial t
                               :components ((:file "main")))))))
--- a/src/2017/main.lisp	Sat Dec 01 15:26:07 2018 -0500
+++ b/src/2017/main.lisp	Sat Dec 01 16:33:14 2018 -0500
@@ -1,39 +1,15 @@
 (in-package :advent)
 
-;;;; Utils --------------------------------------------------------------------
-(defun read-file-of-digits (path)
-  "Read all the ASCII digits in `path` into a list of integers.
-
-  Any character in the file that's not an ASCII digit will be silently ignored.
-
-  "
-  (-<> path
-    read-file-into-string
-    (map 'list #'digit-char-p <>)
-    (remove nil <>)))
-
-(defun read-file-of-numbers (path)
-  (iterate (for line :in-file path :using #'read-line)
-           (appending (mapcar #'parse-integer (str:words line)))))
 
-(defun read-file-of-lines-of-numbers (path)
-  (iterate (for line :in-file path :using #'read-line)
-           (collect (mapcar #'parse-integer (str:words line)))))
-
-(defun read-file-of-lines-of-words (path)
-  (iterate (for line :in-file path :using #'read-line)
-           (collect (str:words line))))
-
+(define-problem (2017 1 1) (data read-file-of-digits)
+  (iterate
+    (for (x . y) :pairs-of-list data)
+    (when (= x y)
+      (sum x))))
 
-;;;; Problems -----------------------------------------------------------------
-(defun day-1/1 ()
-  (iterate (for (x . y) :pairs-of-list (read-file-of-digits "data/2017/01"))
-           (when (= x y)
-             (sum x))))
-
-(defun day-1/2 ()
+(define-problem (2017 1 2) (data read-file-of-digits)
   (iterate
-    (with data = (coerce (read-file-of-digits "data/2017/01") 'vector))
+    (with data = (coerce data 'vector))
     (with length = (length data))
     (for x :in-vector data)
     (for iy :modulo length :from (truncate length 2))
@@ -42,26 +18,24 @@
       (sum x))))
 
 
-(defun day-2/1 ()
+(define-problem (2017 2 1) (data read-file-of-lines-of-numbers)
   (flet ((checksum (line)
-           (- (apply #'max line)
-              (apply #'min line))))
-    (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
-               :key #'checksum)))
+           (- (extremum line #'>)
+              (extremum line #'<))))
+    (summation data :key #'checksum)))
 
-(defun day-2/2 ()
+(define-problem (2017 2 2) (data read-file-of-lines-of-numbers)
   (labels ((validp (a b)
              (dividesp (max a b) (min a b)))
            (head-valid-p (list)
-             (some (curry #'validp (car list))
-                   (cdr list)))
+             (destructuring-bind (n . remaining) list
+               (some (curry #'validp n) remaining)))
            (checksum (line)
              (somelist #'head-valid-p line)))
-    (summation (remove nil (read-file-of-lines-of-numbers "data/2017/02"))
-               :key #'checksum)))
+    (summation data :key #'checksum)))
 
 
-(defun day-3/1 ()
+(define-problem (2017 3 1) (data read-form-from-file)
   (labels ((manhattan-distance (a b)
              (+ (abs (- (realpart a)
                         (realpart b)))
@@ -69,46 +43,45 @@
                         (imagpart b)))))
            (distance-to-origin (p)
              (manhattan-distance #c(0 0) p)))
-    (distance-to-origin (advent.spiral:number-coordinates 325489))))
+    (distance-to-origin (advent.spiral:number-coordinates data))))
 
-(defun day-3/2 ()
+(define-problem (2017 3 2) (data read-form-from-file)
   (flet ((neighbors (coord)
-           (iterate (for-nested ((dx :from -1 :to 1)
-                                 (dy :from -1 :to 1)))
-                    (unless (= 0 dx dy)
-                      (collect (+ coord (complex dx dy)))))))
+           (gathering
+             (do-irange ((dx -1 1)
+                         (dy -1 1))
+               (unless (= 0 dx dy)
+                 (gather (+ coord (complex dx dy))))))))
     (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 325489))
+      (finding value :such-that (> value data))
       (setf (gethash coord memory) value))))
 
 
-(defun day-4/1 ()
+(define-problem (2017 4 1) (data read-file-of-lines-of-words)
   (labels ((contains-duplicates-p (list &key (test #'eql))
              (iterate (for (head . tail) :on list)
                       (thereis (member head tail :test test))))
            (validp (phrase)
              (not (contains-duplicates-p phrase :test #'string=))))
-    (count-if #'validp (read-file-of-lines-of-words "data/2017/04"))))
+    (count-if #'validp data)))
 
-(defun day-4/2 ()
+(define-problem (2017 4 2) (data read-file-of-lines-of-words)
   (labels ((anagramp (string1 string2)
-             (string= (sort (copy-seq string1) #'char<)
-                      (sort (copy-seq string2) #'char<)))
+             (hash-table= (frequencies string1) (frequencies string2)))
            (contains-anagram-p (phrase)
              (iterate (for (word . tail) :on phrase)
                       (thereis (member-if (curry #'anagramp word) tail)))))
-    (count-if-not #'contains-anagram-p
-                  (read-file-of-lines-of-words "data/2017/04"))))
+    (count-if-not #'contains-anagram-p data)))
 
 
-(defun day-5/1 ()
+(define-problem (2017 5 1) (data read-all-from-file)
   (iterate
-    (with maze = (coerce (read-file-of-numbers "data/2017/05") 'vector))
+    (with maze = (coerce data 'simple-vector))
     (with bound = (1- (length maze)))
     (with address = 0)
     (for steps :from 0)
@@ -117,11 +90,9 @@
     (incf (aref maze address))
     (incf address offset)))
 
-(defun day-5/2 ()
+(define-problem (2017 5 2) (data read-all-from-file)
   (iterate
-    (declare (optimize speed)
-             (type fixnum bound address steps offset))
-    (with maze = (coerce (read-file-of-numbers "data/2017/05") 'simple-vector))
+    (with maze = (coerce data 'simple-vector))
     (with bound = (1- (length maze)))
     (with address = 0)
     (for steps :from 0)
@@ -132,9 +103,9 @@
     (incf address offset)))
 
 
-(defun day-6/1+2 ()
-  (let* ((banks (coerce (read-file-of-numbers "data/2017/06") 'vector))
-         (seen (make-hash-table :test 'equalp)))
+(define-problem (2017 6) (data read-all-from-file)
+  (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)))
@@ -149,9 +120,9 @@
              (mark-seen (banks cycles)
                (setf (gethash (copy-seq banks) seen) cycles)))
       (iterate
-        (mark-seen banks cycles)
-        (summing 1 :into cycles)
+        (mark-seen banks cycle)
+        (summing 1 :into cycle)
         (redistribute)
         (for last-seen = (gethash banks seen))
         (until last-seen)
-        (finally (return (values cycles (- cycles last-seen))))))))
+        (finally (return (values cycle (- cycle last-seen))))))))
--- a/src/2018/main.lisp	Sat Dec 01 15:26:07 2018 -0500
+++ b/src/2018/main.lisp	Sat Dec 01 16:33:14 2018 -0500
@@ -1,18 +1,10 @@
 (in-package :advent)
 
-;;;; Utils --------------------------------------------------------------------
-(defmacro define-problem ((day part) (data-symbol reader) &body body)
-  (let ((function-name (symb 'day- day '/ part)))
-    `(defun ,function-name ()
-       (let ((,data-symbol (,reader ,(format nil "data/2018/~2,'0D.txt" day))))
-         ,@body))))
-
-
 ;;;; Problems -----------------------------------------------------------------
-(define-problem (1 1) (data read-all-from-file)
+(define-problem (2018 1 1) (data read-all-from-file)
   (summation data))
 
-(define-problem (1 2) (data read-all-from-file)
+(define-problem (2018 1 2) (data read-all-from-file)
   (setf (cdr (last data)) data) ; make data a circular list for easy looping
   (iterate
     (with seen = (make-hash-set :initial-contents '(0)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/utils.lisp	Sat Dec 01 16:33:14 2018 -0500
@@ -0,0 +1,63 @@
+(in-package :advent)
+
+;;;; Problems -----------------------------------------------------------------
+(defmacro define-problem ((year day &optional part)
+                          (data-symbol reader)
+                          &body body)
+  (let ((function-name (if part
+                         (symb 'advent- year '- day '/ part)
+                         (symb 'advent- year '- day))))
+    `(defun ,function-name ()
+       (let ((,data-symbol (,reader ,(format nil "data/~D/~2,'0D.txt" year day))))
+         ,@body))))
+
+
+;;;; Readers ------------------------------------------------------------------
+(defun read-form-from-file (path)
+  "Read the first form from `path`."
+  (with-open-file (s path)
+    (read s)))
+
+
+(defun read-file-of-digits (path)
+  "Read all the ASCII digits in `path` into a list of integers.
+
+  Any character in the file that's not an ASCII digit will be silently ignored.
+
+  "
+  (-<> path
+    read-file-into-string
+    (map 'list #'digit-char-p <>)
+    (remove nil <>)))
+
+(defun read-file-of-lines-of-numbers (path)
+  "Read the lines of numbers in `path` into a list of lists of numbers.
+
+  Each line must consist of whitespace-separated integers.  Empty lines will be
+  discarded.
+
+  "
+  (iterate (for line :in-file path :using #'read-line)
+           (for numbers = (mapcar #'parse-integer (str:words line)))
+           (when numbers
+             (collect numbers))))
+
+(defun read-file-of-lines-of-words (path)
+  (iterate (for line :in-file path :using #'read-line)
+           (collect (str:words line))))
+
+
+;;;; Miscellaneous ------------------------------------------------------------
+(defun hash-table= (h1 h2 &optional (test #'eql))
+  "Return whether `h1` and `h2` have the same keys and values.
+
+  The consequences are undefined if `h1` and `h2` use different key tests.
+
+  `test` is used to compare values.
+
+  "
+  (and (= (hash-table-count h1)
+          (hash-table-count h2))
+       (iterate (for (k v) :in-hashtable h1)
+                (always (funcall test v (gethash k h2))))))
+
--- a/vendor/make-quickutils.lisp	Sat Dec 01 15:26:07 2018 -0500
+++ b/vendor/make-quickutils.lisp	Sat Dec 01 16:33:14 2018 -0500
@@ -4,6 +4,7 @@
   "quickutils.lisp"
   :utilities '(
 
+               :extremum
                :compose
                :curry
                :ensure-keyword
--- a/vendor/quickutils.lisp	Sat Dec 01 15:26:07 2018 -0500
+++ b/vendor/quickutils.lisp	Sat Dec 01 16:33:14 2018 -0500
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:EXTREMUM :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :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,15 +13,7 @@
 (in-package "ADVENT.QUICKUTILS")
 
 (when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :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
+  (setf *utilities* (union *utilities* '(:ENSURE-FUNCTION :EXTREMUM :MAKE-GENSYM-LIST :COMPOSE :CURRY :ENSURE-KEYWORD :RANGE :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
 (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.
@@ -38,6 +30,58 @@
         (fdefinition function-designator)))
   )                                        ; eval-when
 
+  (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`.
+
+`extremum` determines the relationship between two elements of `sequence` by using
+the `predicate` function. `predicate` should return true if and only if the first
+argument is strictly less than the second one (in some appropriate sense). Two
+arguments `x` and `y` are considered to be equal if `(funcall predicate x y)`
+and `(funcall predicate y x)` are both false.
+
+The arguments to the `predicate` function are computed from elements of `sequence`
+using the `key` function, if supplied. If `key` is not supplied or is `nil`, the
+sequence element itself is used.
+
+If `sequence` is empty, `nil` is returned."
+    (let* ((pred-fun (ensure-function predicate))
+           (key-fun (unless (or (not key) (eq key 'identity) (eq key #'identity))
+                      (ensure-function key)))
+           (real-end (or end (length sequence))))
+      (cond ((> real-end start)
+             (if key-fun
+                 (flet ((reduce-keys (a b)
+                          (if (funcall pred-fun
+                                       (funcall key-fun a)
+                                       (funcall key-fun b))
+                              a
+                              b)))
+                   (declare (dynamic-extent #'reduce-keys))
+                   (reduce #'reduce-keys sequence :start start :end real-end))
+                 (flet ((reduce-elts (a b)
+                          (if (funcall pred-fun a b)
+                              a
+                              b)))
+                   (declare (dynamic-extent #'reduce-elts))
+                   (reduce #'reduce-elts sequence :start start :end real-end))))
+            ((= real-end start)
+             nil)
+            (t
+             (error "Invalid bounding indexes for sequence of length ~S: ~S ~S, ~S ~S"
+                    (length sequence)
+                    :start start
+                    :end end)))))
+  
+(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`,
@@ -218,6 +262,6 @@
     (values (intern (apply #'mkstr args))))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry ensure-keyword range rcurry read-file-into-string symb)))
+  (export '(extremum compose curry ensure-keyword range rcurry read-file-into-string symb)))
 
 ;;;; END OF quickutils.lisp ;;;;