--- a/.hgignore Mon Dec 10 00:51:46 2018 -0500
+++ b/.hgignore Sat Dec 15 16:52:29 2018 -0500
@@ -10,3 +10,4 @@
data
scratch.lisp
digraph.png
+lisp.prof
--- a/advent.asd Mon Dec 10 00:51:46 2018 -0500
+++ b/advent.asd Sat Dec 15 16:52:29 2018 -0500
@@ -1,3 +1,14 @@
+(defclass auto-module (module) ())
+
+(defmethod component-children ((self auto-module))
+ (mapcar (lambda (p) (make-instance 'cl-source-file :type "lisp"
+ :pathname p
+ :name (pathname-name p)
+ :parent (component-parent self)))
+ (directory-files (component-pathname self)
+ (make-pathname :directory nil :name *wild* :type "lisp"))))
+
+
(asdf:defsystem :advent
:description "Advent of Code solutions"
@@ -7,6 +18,8 @@
:depends-on (
+ :1am
+ :alexandria
:cl-digraph
:cl-digraph.dot
:cl-interpol
@@ -26,8 +39,7 @@
(:file "package")
(:module "src" :serial t
:components ((:file "utils")
- (:module "2017" :serial t
- :components ((:file "number-spiral")
- (:file "main")))
- (:module "2018" :serial t
- :components ((:file "main")))))))
+ #+later (:module "2017" :serial t
+ :components ((:file "number-spiral")
+ (:file "main")))
+ (:auto-module "2018")))))
--- a/package.lisp Mon Dec 10 00:51:46 2018 -0500
+++ b/package.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -1,3 +1,46 @@
(defpackage :advent
- (:use :cl :losh :iterate :advent.quickutils))
+ (:use :cl :losh :iterate :advent.quickutils)
+ (:export
+ :define-problem
+
+ :read-all
+ :read-lines
+ :read-lines-of-numbers-and-garbage
+
+ :ensure-string
+ :ensure-stream
+
+ :char-invertcase
+ :emptyp
+ :extremum+
+ :extremums
+ :hamming-distance
+ :hash-table=
+ :integral-range
+ :manhattan-distance
+ :manhattan-neighbors
+ :nth-digit
+ :unique
+ :ring
+ :ring-prev
+ :ring-next
+ :ring-data
+ :map-ring
+ :do-ring
+ :ring-list
+ :ring-length
+ :ring-move
+ :ring-insert-after
+ :ring-insert-before
+ :ring-cutf
+ :ring-prevf
+ :ring-nextf
+ :ring-cutf
+ :ring-movef
+ :ring-insertf-after
+ :ring-insertf-before
+
+ ))
+
+(defparameter *advent-use* '(:use :cl :losh :iterate :advent :advent.quickutils))
--- a/src/2015/2015.lisp Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,898 +0,0 @@
-; https://bitbucket.org/sjl/beef
-(ql:quickload "beef")
-(ql:quickload "alexandria")
-(ql:quickload "split-sequence")
-(ql:quickload "cl-arrows")
-(ql:quickload "fset")
-(ql:quickload "cl-ppcre")
-(ql:quickload "ironclad")
-(ql:quickload "smug")
-(ql:quickload "bit-smasher")
-(ql:quickload "optima")
-
-(defpackage #:advent
- (:use #:cl)
- (:use #:cl-arrows)
- (:use #:split-sequence)
- (:use #:smug))
-
-(in-package #:advent)
-
-(declaim (optimize (debug 3)))
-
-;;;; Day 1
-(defun instruction-to-num (ch)
- (cond
- ((eql ch #\() 1)
- ((eql ch #\)) -1)
- (t 0)))
-
-(defun advent-1-1 ()
- (loop :for c :across (beef:slurp "data/1")
- :sum (instruction-to-num c)))
-
-(defun advent-1-2 ()
- (loop :for c :across (beef:slurp "data/1")
- :sum (instruction-to-num c) :into floor
- :sum 1
- :until (= floor -1)))
-
-
-;;;; Day 2
-(defun advent-2-data ()
- (->> (beef:slurp "data/2")
- beef:trim-whitespace-right
- beef:split-lines
- (mapcar (lambda (s)
- (->> s
- (split-sequence #\x)
- (mapcar #'parse-integer))))))
-
-(defun advent-2-1 ()
- (loop :for dims :in (advent-2-data)
- :for (w h l) = dims
- :for sides = (list (* w h)
- (* w l)
- (* h l))
- :for paper = (* 2 (apply #'+ sides))
- :for slack = (apply #'min sides)
- :sum (+ paper slack)))
-
-(defun advent-2-2 ()
- (loop :for dims :in (advent-2-data)
- :for (w h l) = dims
- :for sides = (list (* 2 (+ w h))
- (* 2 (+ w l))
- (* 2 (+ h l)))
- :for ribbon = (apply #'min sides)
- :for bow = (apply #'* dims)
- :sum (+ ribbon bow)))
-
-
-;;;; Day 3
-(defun advent-3-data ()
- (beef:trim-whitespace (beef:slurp "data/3")))
-
-(defun instruction-to-offsets (instruction)
- (case instruction
- (#\> '(1 0))
- (#\< '(-1 0))
- (#\^ '(0 1))
- (#\v '(0 -1))))
-
-(defun step-santa (loc dir)
- (destructuring-bind (x y) loc
- (destructuring-bind (dx dy) (instruction-to-offsets dir)
- (list (+ x dx) (+ y dy)))))
-
-(defun houses (data)
- (loop
- :with loc = '(0 0)
- :with visited = (fset:set '(0 0))
- :for dir :across data
- :do (setq loc (step-santa loc dir))
- :do (fset:includef visited loc)
- :finally (return visited)))
-
-(defun advent-3-1 (data)
- (fset:size (houses data)))
-
-(defun advent-3-2 (data)
- (fset:size
- (fset:union
- ; come directly at me
- (houses (ppcre:regex-replace-all "(.)." data "\\1"))
- (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
-
-
-;;;; Day 4
-(defun advent-4-data ()
- "ckczppom")
-
-(defun md5 (str)
- (ironclad:byte-array-to-hex-string
- (ironclad:digest-sequence :md5
- (ironclad:ascii-string-to-byte-array str))))
-
-(defun mine (data zeroes)
- (let ((target (apply #'concatenate 'string
- (loop :repeat zeroes :collect "0"))))
- (loop :for i :upfrom 1
- :for hash = (->> i
- prin1-to-string
- (concatenate 'string data)
- md5)
- :until (equal target (subseq hash 0 zeroes))
- :finally (return i))))
-
-(defun advent-4-1 (data)
- (mine data 5))
-
-(defun advent-4-2 (data)
- (mine data 6))
-
-
-;;;; Day 5
-(defun advent-5-data ()
- (-> "data/5"
- beef:slurp
- beef:trim-whitespace-right
- beef:split-lines))
-
-(defun join-strings (strings delim)
- "Join strings into a single string with the given delimiter string interleaved.
-
- Delim must not contain a ~.
-
- "
- (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
-
-
-(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
-
-(defun count-vowels (s)
- (length (ppcre:regex-replace-all "[^aeiou]" s "")))
-
-(defun has-run (s)
- (when (ppcre:scan "(.)\\1" s) t))
-
-(defun has-bad (s)
- (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
-
-(defun is-nice (s)
- (and (>= (count-vowels s) 3)
- (has-run s)
- (not (has-bad s))))
-
-(defun advent-5-1 (data)
- (count-if #'is-nice data))
-
-(defun has-run-2 (s)
- (when (ppcre:scan "(..).*\\1" s) t))
-
-(defun has-repeat (s)
- (when (ppcre:scan "(.).\\1" s) t))
-
-(defun is-nice-2 (s)
- (and (has-run-2 s)
- (has-repeat s)))
-
-(defun advent-5-2 (data)
- (count-if #'is-nice-2 data))
-
-
-;;;; Day 6
-(defun advent-6-data ()
- (beef:slurp-lines "data/6" :ignore-trailing-newline t))
-
-(defmacro loop-array (arr name &rest body)
- (let ((i (gensym "index")))
- `(loop :for ,i :below (array-total-size ,arr)
- :for ,name = (row-major-aref ,arr ,i)
- ,@body)))
-
-(defun parse-indexes (s)
- (->> s
- (split-sequence #\,)
- (mapcar #'parse-integer)))
-
-(defun flip (b)
- (if (zerop b) 1 0))
-
-(defun parse-line (line)
- (let ((parts (split-sequence #\space line)))
- (list (parse-indexes (beef:index parts -3))
- (parse-indexes (beef:index parts -1))
- (cond
- ((equal (car parts) "toggle") :toggle)
- ((equal (cadr parts) "on") :on)
- ((equal (cadr parts) "off") :off)
- (t (error "Unknown operation!"))))))
-
-(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
- `(loop :for ,r :from ,from-row :to ,to-row
- :do (loop :for ,c :from ,from-col :to ,to-col
- ,@body)))
-
-(defun advent-6-1 (data)
- (let ((lights (make-array '(1000 1000) :element-type 'bit)))
- (loop
- :for line :in data
- :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
- :do (loop-square
- r c from-row from-col to-row to-col
- :do (setf (bit lights r c)
- (case operation
- (:toggle (flip (bit lights r c)))
- (:on 1)
- (:off 0)
- (t 0)))))
- (loop-array lights b
- :sum b)))
-
-(defun advent-6-2 (data)
- (let ((lights (make-array '(1000 1000) :element-type 'integer)))
- (loop
- :for line :in data
- :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
- :do (loop-square
- r c from-row from-col to-row to-col
- :do (case operation
- (:toggle (incf (aref lights r c) 2))
- (:on (incf (aref lights r c)))
- (:off (when (not (zerop (aref lights r c)))
- (decf (aref lights r c)))))))
- (loop-array lights b
- :sum b)))
-
-
-;;;; Day 7
-(defun advent-7-data ()
- (beef:slurp-lines "data/7" :ignore-trailing-newline t))
-
-(defun advent-7-2-data ()
- (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
-
-(defun int->bits (i)
- (bitsmash:bits<- (format nil "~4,'0X" i)))
-
-(defun bit-lshift (bit-array distance)
- (replace (make-array (length bit-array) :element-type 'bit)
- bit-array
- :start1 0
- :start2 (bitsmash:int<- distance)))
-
-(defun bit-rshift (bit-array distance)
- (let ((width (length bit-array))
- (distance (bitsmash:int<- distance)))
- (replace (make-array width :element-type 'bit)
- bit-array
- :start1 distance
- :end2 (- width distance))))
-
-(defun .zero-or-more (parser)
- (.plus (.let* ((x parser)
- (xs (.zero-or-more parser)))
- (.identity (cons x xs)))
- (.identity ())))
-
-(defun .one-or-more (parser)
- (.let* ((x parser)
- (y (.zero-or-more parser)))
- (.identity (cons x y))))
-
-(defun parse-7 (line)
- (labels ((.whitespace ()
- (.first (.one-or-more (.is 'member '(#\space #\tab)))))
- (.arrow ()
- (.first (.string= "->")))
- (.number ()
- (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
- (.identity (parse-integer (concatenate 'string digits)))))
- (.wire ()
- (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
- (.identity (concatenate 'string chars))))
- (.source ()
- (.or (.wire) (.number)))
- (.string-choice (strs)
- (if (not strs)
- (.fail)
- (.or (.string= (car strs))
- (.string-choice (cdr strs)))))
- (.dest ()
- (.progn (.whitespace) (.arrow) (.whitespace)
- (.wire)))
- (.constant-source ()
- (.let* ((val (.source)))
- (.identity (list #'identity (list val)))))
- (.binary-op ()
- (let ((ops '(("AND" . bit-and)
- ("OR" . bit-ior)
- ("LSHIFT" . bit-lshift)
- ("RSHIFT" . bit-rshift))))
- (.let* ((name (.string-choice (mapcar #'car ops))))
- (.identity (cdr (assoc name ops :test #'equal))))))
- (.binary-source ()
- (.let* ((left (.source))
- (_ (.whitespace))
- (op (.binary-op))
- (_ (.whitespace))
- (right (.source)))
- (.identity (list op (list left right)))))
- (.unary-op ()
- (.let* ((_ (.string= "NOT")))
- (.identity #'bit-not)))
- (.unary-source ()
- (.let* ((op (.unary-op))
- (_ (.whitespace))
- (source (.source)))
- (.identity (list op (list source)))))
- (.instruction ()
- (.let* ((source (.or (.binary-source)
- (.unary-source)
- (.constant-source)))
- (dest (.dest)))
- (.identity (concatenate 'list source (list dest))))))
- (parse (.instruction) line)))
-
-(defun advent-7-1 (data)
- (let ((circuit (make-hash-table :test #'equal))
- (commands (mapcar #'parse-7 data)))
- (labels ((retrieve (source)
- (cond
- ((stringp source) (gethash source circuit))
- ((integerp source) (int->bits source))
- (t (error "what?"))))
- (ready (args)
- (every #'identity args))
- (perform (fn args dest)
- (setf (gethash dest circuit)
- (apply fn args)))
- (try-command (command)
- "If the command is ready to go, run it and return nil. Otherwise,
- return the command itself."
- (destructuring-bind (fn args dest) command
- (let ((vals (mapcar #'retrieve args)))
- (if (ready vals)
- (progn
- (perform fn vals dest)
- nil)
- command)))))
- (loop :while commands
- :do (setf commands
- (loop :for command :in commands
- :when (try-command command)
- :collect :it)))
- (bitsmash:bits->int (gethash "a" circuit)))))
-
-
-;;;; Day 8
-(defun advent-8-data ()
- (beef:slurp-lines "data/8" :ignore-trailing-newline t))
-
-
-(defconstant +backslash+ #\\ )
-(defconstant +quote+ #\" )
-
-(defun parse-8 (line)
- (labels ((.hex-digit ()
- (.or
- (.is #'digit-char-p)
- (.is #'member '(#\a #\b #\c #\d #\e #\f))))
- (.hex-escape ()
- (.let* ((_ (.char= #\x))
- (a (.hex-digit))
- (b (.hex-digit)))
- (.identity
- (->> (format nil "~A~A" a b)
- bitsmash:hex->int
- code-char))))
- (.escaped-char ()
- (.progn
- (.char= +backslash+)
- (.or (.char= +backslash+)
- (.char= +quote+)
- (.hex-escape))))
- (.normal-char ()
- (.is-not 'member (list +backslash+ +quote+)))
- (.string-char ()
- (.or (.normal-char)
- (.escaped-char)))
- (.full-string ()
- (.prog2
- (.char= +quote+)
- (.first (.zero-or-more (.string-char)))
- (.char= +quote+))))
- (parse (.full-string) line)))
-
-(defun .wrap (fn parser)
- (.let* ((v parser))
- (.identity (funcall fn v))))
-
-(defun parse-8-2 (line)
- (labels ((.special-char ()
- (.let* ((ch (.or (.char= +backslash+)
- (.char= +quote+))))
- (.identity (list +backslash+ ch))))
- (.normal-char ()
- (.wrap #'list
- (.is-not 'member (list +backslash+ +quote+))))
- (.string-char ()
- (.or (.normal-char)
- (.special-char)))
- (.full-string ()
- (.let* ((chars (.zero-or-more (.string-char))))
- (.identity (apply #'concatenate 'list chars)))))
- (append (list +quote+)
- (parse (.full-string) line)
- (list +quote+))))
-
-(defun advent-8-1 (data)
- (loop :for line :in data
- :for chars = (parse-8 line)
- :sum (- (length line)
- (length chars))))
-
-(defun advent-8-2 (data)
- (loop :for line :in data
- :for chars = (parse-8-2 line)
- :sum (- (length chars)
- (length line))))
-
-
-;;;; Day 9
-(defun advent-9-data ()
- (beef:slurp-lines "data/9" :ignore-trailing-newline t))
-
-; Thanks Norvig
-; http://norvig.com/paip/gps.lisp
-(defun permutations (bag)
- "Return a list of all the permutations of the input."
- ;; If the input is nil, there is only one permutation:
- ;; nil itself
- (if (null bag)
- '(())
- ;; Otherwise, take an element, e, out of the bag.
- ;; Generate all permutations of the remaining elements,
- ;; And add e to the front of each of these.
- ;; Do this for all possible e to generate all permutations.
- (mapcan #'(lambda (e)
- (mapcar #'(lambda (p) (cons e p))
- (permutations
- (remove e bag :count 1 :test #'eq))))
- bag)))
-
-(defun advent-9 (data)
- (let ((distances (make-hash-table :test #'equal)))
- (loop :for line :in data
- :for (a to b _ dist) = (split-sequence #\space line)
- :for distance = (parse-integer dist)
- :do (progn
- (setf (gethash (cons a b) distances) distance)
- (setf (gethash (cons b a) distances) distance)))
- (labels ((score-route (route)
- (optima:match route
- ((list _) 0)
- ((list* a b _) (+ (gethash (cons a b) distances)
- (score-route (cdr route))))))
- (dedupe (l)
- (remove-duplicates l :test #'equal)))
- (loop :for route :in (->> distances
- beef:hash-keys
- (mapcar #'car)
- dedupe
- permutations)
- :for score = (score-route route)
- :minimizing score :into min-dist
- :maximizing score :into max-dist
- :finally (return (cons min-dist max-dist))))))
-
-
-(defmethod print-object ((object hash-table) stream)
- (format stream "#HASH{~%~{~{ (~s : ~s)~}~%~}}"
- (loop for key being the hash-keys of object
- using (hash-value value)
- collect (list key value))))
-
-
-;;;; Day 10
-(defun advent-10-data ()
- "1321131112")
-
-(defun look-and-say (seq)
- (let ((runs (list))
- (len 1)
- (current -1))
- (flet ((mark-run ()
- (setf runs (cons current (cons len runs)))))
- (loop :for n :in seq
- :do (if (= current n)
- (incf len)
- (progn
- (when (not (= -1 current))
- (mark-run))
- (setf len 1)
- (setf current n)))
- :finally (mark-run))
- (reverse runs))))
-
-(defun iterate (n f data)
- (declare (optimize speed (debug 0)))
- (dotimes (_ n)
- (setf data (funcall f data)))
- data)
-
-(defun las-to-list (s)
- (loop :for digit :across s
- :collect (-> digit string parse-integer)))
-
-(defun advent-10-1 (data)
- (length (iterate 40 #'look-and-say (las-to-list data))))
-
-(defun advent-10-2 (data)
- (length (iterate 50 #'look-and-say (las-to-list data))))
-
-
-;;;; Day 11
-(defun advent-11-data ()
- "vzbxkghb")
-
-
-(defparameter base 26)
-(defparameter ascii-alpha-start (char-code #\a))
-(defun num-to-char (n)
- (code-char (+ n ascii-alpha-start)))
-
-(defun char-to-num (ch)
- (- (char-code ch) ascii-alpha-start))
-
-
-(defmacro loop-window (seq width binding-form &rest body)
- (let ((i (gensym "IGNORE"))
- (s (gensym "SEQ"))
- (n (gensym "WIDTH"))
- (tail (gensym "TAIL")))
- `(let ((,s ,seq)
- (,n ,width))
- (loop :for ,i :upto (- (length ,s) ,n)
- :for ,tail :on ,s
- :for ,binding-form = (subseq ,tail 0 ,n)
- ,@body))))
-
-
-(defun is-straight-3 (l)
- (destructuring-bind (a b c) l
- (and (= 1 (- b a))
- (= 1 (- c b)))))
-
-(defun has-straight-3 (nums)
- (loop-window nums 3 triplet
- :thereis (is-straight-3 triplet)))
-
-
-(defparameter bad-chars
- (mapcar #'char-to-num '(#\i #\l #\o)))
-
-(defun no-bad (nums)
- (loop :for bad :in bad-chars
- :never (find bad nums)))
-
-
-(defun two-pairs (nums)
- (-> nums
- (loop-window 2 (a b)
- :when (= a b)
- :collect a)
- remove-duplicates
- length
- (>= 2)))
-
-
-(defun valid (nums)
- (and (has-straight-3 nums)
- (no-bad nums)
- (two-pairs nums)
- nums))
-
-
-(defun incr-nums (nums)
- (labels ((inc-mod (x)
- (mod (1+ x) base))
- (inc (nums)
- (if (not nums)
- '(1)
- (let ((head (inc-mod (car nums))))
- (if (zerop head)
- (cons head (inc (cdr nums)))
- (cons head (cdr nums)))))))
- (reverse (inc (reverse nums)))))
-
-
-(defun advent-11-1 (data)
- (flet ((chars-to-string (chs)
- (apply #'concatenate 'string (mapcar #'string chs)))
- (nums-to-chars (nums)
- (mapcar #'num-to-char nums))
- (string-to-nums (str)
- (loop :for ch :across str
- :collect (char-to-num ch))))
- (-> (loop :for pw = (incr-nums (string-to-nums data))
- :then (incr-nums pw)
- :thereis (valid pw))
- nums-to-chars
- chars-to-string)))
-
-
-;;;; Day 12
-(defun advent-12-data ()
- (beef:trim-whitespace (beef:slurp "data/12")))
-
-
-(defun parse-json (s)
- (labels ((.number ()
- (.let* ((negation (.optional (.char= #\-)))
- (digits (.first (.one-or-more (.is 'digit-char-p)))))
- (.identity (let ((i (parse-integer (concatenate 'string digits)))
- (c (if negation -1 1)))
- (* i c)))))
- (.string-char ()
- (.wrap #'list (.is-not 'member (list +quote+))))
- (.string-guts ()
- (.let* ((chars (.zero-or-more (.string-char))))
- (.identity (apply #'concatenate 'string chars))))
- (.string ()
- (.prog2
- (.char= +quote+)
- (.string-guts)
- (.char= +quote+)))
- (.map-pair ()
- (.let* ((key (.string))
- (_ (.char= #\:))
- (value (.expression)))
- (.identity (cons key value))))
- (.map-guts ()
- (.or
- (.let* ((p (.map-pair))
- (_ (.char= #\,))
- (remaining (.map-guts)))
- (.identity (cons p remaining)))
- (.wrap #'list (.map-pair))
- (.identity '())))
- (.map ()
- (.prog2
- (.char= #\{)
- (.wrap (lambda (v) (cons :map v))
- (.map-guts))
- (.char= #\})))
- (.array-guts ()
- (.or
- (.let* ((item (.expression))
- (_ (.char= #\,))
- (remaining (.array-guts)))
- (.identity (cons item remaining)))
- (.wrap #'list (.expression))
- (.identity '())))
- (.array ()
- (.prog2
- (.char= #\[)
- (.wrap (lambda (v) (cons :array v))
- (.array-guts))
- (.char= #\])))
- (.expression ()
- (.or (.array)
- (.map)
- (.string)
- (.number))))
- (parse (.expression) s)))
-
-(defun walk-sum (v)
- (cond
- ((not v) 0)
- ((typep v 'integer) v)
- ((typep v 'string) 0)
- ((eql (car v) :array) (loop :for value in (cdr v)
- :sum (walk-sum value)))
- ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
- :sum (walk-sum value)))
- (:else (error (format nil "wat? ~a" v)))))
-
-(defun walk-sum-2 (v)
- (cond
- ((not v) 0)
- ((typep v 'integer) v)
- ((typep v 'string) 0)
- ((eql (car v) :array) (loop :for value in (cdr v)
- :sum (walk-sum-2 value)))
- ((eql (car v) :map)
- (if (member "red" (mapcar #'cdr (cdr v))
- :test #'equal)
- 0
- (loop :for (key . value) :in (cdr v)
- :sum (walk-sum-2 value))))
- (:else (error (format nil "wat? ~a" v)))))
-
-
-(defun advent-12-1 (data)
- (walk-sum (parse-json data)))
-
-(defun advent-12-2 (data)
- (walk-sum-2 (parse-json data)))
-
-
-;;;; Day 13
-(defun advent-13-data ()
- (beef:slurp-lines "data/13" :ignore-trailing-newline t))
-
-
-(defvar *wat* nil)
-
-(defmacro map-when (test fn val &rest args)
- (let ((v (gensym "VALUE")))
- `(let ((,v ,val))
- (if ,test
- (apply ,fn ,v ,args)
- ,v))))
-
-(defun split-lines-13 (lines)
- (loop :for line :in lines
- :collect (ppcre:register-groups-bind
- (a dir amount b)
- ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
- line)
- (list a b (map-when (equal "lose" dir)
- #'-
- (parse-integer amount))))))
-
-(defun rate-seating (vals arrangement)
- (labels ((find-val (a b)
- (or (gethash (cons a b) vals) 0))
- (rate-one-direction (arr)
- (+ (loop-window arr 2 (a b) :sum (find-val a b))
- (find-val (car (last arr)) (car arr)))))
- (+ (rate-one-direction arrangement)
- (rate-one-direction (reverse arrangement)))))
-
-(defun advent-13-1 (data)
- (let* ((tups (split-lines-13 data))
- (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
- (vals (make-hash-table :test #'equal)))
- (loop :for (a b val) :in tups
- :do (setf (gethash (cons a b) vals) val))
- (loop :for arrangement :in (permutations attendees)
- :maximize (rate-seating vals arrangement))))
-
-(defun advent-13-2 (data)
- (let* ((tups (split-lines-13 data))
- (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
- (vals (make-hash-table :test #'equal)))
- (loop :for (a b val) :in tups
- :do (setf (gethash (cons a b) vals) val))
- (loop :for arrangement :in (permutations attendees)
- :maximize (rate-seating vals arrangement))))
-
-
-;;;; Day 14
-(defun advent-14-data ()
- (beef:slurp-lines "data/14" :ignore-trailing-newline t))
-
-
-(defun tick (deer)
- (destructuring-bind
- (name speed sprint-period rest-period traveled currently remaining)
- deer
- (let ((remaining (1- remaining)))
- (if (equal currently :resting)
- (list name speed sprint-period rest-period
- traveled
- (if (zerop remaining) :sprinting :resting)
- (if (zerop remaining) sprint-period remaining))
- (list name speed sprint-period rest-period
- (+ traveled speed)
- (if (zerop remaining) :resting :sprinting)
- (if (zerop remaining) rest-period remaining))))))
-
-(defun parse-deers (lines)
- (loop :for line :in lines
- :collect (ppcre:register-groups-bind
- (name speed sprint-period rest-period)
- ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
- line)
- (list name
- (parse-integer speed)
- (parse-integer sprint-period)
- (parse-integer rest-period)
- 0
- :sprinting
- (parse-integer sprint-period)))))
-
-(defun find-leaders (deers)
- (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
- (remove-if-not (lambda (deer)
- (= dist (nth 4 deer)))
- deers)))
-
-
-(defun advent-14-1 (data n)
- (apply #'max
- (loop :for i :upto n
- :for deers := (parse-deers data) :then (mapcar #'tick deers)
- :finally (return (mapcar (beef:partial #'nth 4) deers)))))
-
-(defun advent-14-2 (data n)
- (let ((scores (make-hash-table :test #'equal))
- (deers (parse-deers data)))
- (loop :for (name) :in deers
- :do (setf (gethash name scores) 0))
- (loop :for i :upto n
- :do (setf deers (mapcar #'tick deers))
- :do (loop :for (name) :in (find-leaders deers)
- :do (incf (gethash name scores))))
- (apply #'max (beef:hash-values scores))))
-
-
-
-;;;; Day 15
-(defun advent-15-data ()
- (beef:slurp-lines "data/15" :ignore-trailing-newline t))
-
-(defun split-ingredients (line)
- (ppcre:register-groups-bind
- (name (#'parse-integer capacity durability flavor texture calories))
- ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
- line)
- (list name capacity durability flavor texture calories)))
-
-(defun calc-contribution (ingr amount)
- (cons (car ingr)
- (mapcar (beef:partial #'* amount)
- (cdr ingr))))
-
-(defun calc-contributions (ingrs alist)
- (mapcar #'calc-contribution ingrs alist))
-
-(defun sum-totals (ingrs)
- (->> ingrs
- (mapcar #'cdr)
- (apply #'mapcar #'+)
- (mapcar (lambda (x) (if (< x 0) 0 x)))))
-
-(defun advent-15-1 (data)
- (let ((ingredients (mapcar #'split-ingredients data))
- (limit 100)
- (amounts (list)))
- ; fuckin lol
- (loop :for a :upto limit :do
- (loop :for b :upto (- limit a) :do
- (loop :for c :upto (- limit a b) :do
- (setf amounts
- (cons (list a b c (- limit a b c))
- amounts)))))
- (loop :for alist :in amounts
- :maximize (->> alist
- (calc-contributions ingredients)
- sum-totals
- butlast
- (apply #'*)))))
-
-(defun advent-15-2 (data)
- (let ((ingredients (mapcar #'split-ingredients data))
- (limit 100)
- (amounts (list)))
- ; fuckin lol
- (loop :for a :upto limit :do
- (loop :for b :upto (- limit a) :do
- (loop :for c :upto (- limit a b) :do
- (setf amounts
- (cons (list a b c (- limit a b c))
- amounts)))))
- (loop :for alist :in amounts
- :for val = (->> alist
- (calc-contributions ingredients)
- sum-totals)
- :when (= (car (last val)) 500)
- :maximize (apply #'* (butlast val)))))
-
-
-;;;; Scratch
-#+comment
-(advent-15-2 (advent-15-data))
--- a/src/2017/main.lisp Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,155 +0,0 @@
-(in-package :advent)
-(named-readtables:in-readtable :interpol-syntax)
-
-
-(define-problem (2017 1 1) (data read-file-of-digits)
- (iterate
- (for (x . y) :pairs-of-list data)
- (when (= x y)
- (sum x))))
-
-(define-problem (2017 1 2) (data read-file-of-digits)
- (iterate
- (with data = (coerce data 'vector))
- (with length = (length data))
- (for x :in-vector data)
- (for iy :modulo length :from (truncate length 2))
- (for y = (aref data iy))
- (when (= x y)
- (sum x))))
-
-
-(define-problem (2017 2 1) (data read-file-of-lines-of-numbers)
- (flet ((checksum (line)
- (- (extremum line #'>)
- (extremum line #'<))))
- (summation data :key #'checksum)))
-
-(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)
- (destructuring-bind (n . remaining) list
- (some (curry #'validp n) remaining)))
- (checksum (line)
- (somelist #'head-valid-p line)))
- (summation data :key #'checksum)))
-
-
-(define-problem (2017 3 1) (data read-form-from-file)
- (labels ((manhattan-distance (a b)
- (+ (abs (- (realpart a)
- (realpart b)))
- (abs (- (imagpart a)
- (imagpart b)))))
- (distance-to-origin (p)
- (manhattan-distance #c(0 0) p)))
- (distance-to-origin (advent.spiral:number-coordinates data))))
-
-(define-problem (2017 3 2) (data read-form-from-file)
- (flet ((neighbors (coord)
- (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 data))
- (setf (gethash coord memory) value))))
-
-
-(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 data)))
-
-(define-problem (2017 4 2) (data read-file-of-lines-of-words)
- (labels ((anagramp (string1 string2)
- (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 data)))
-
-
-(define-problem (2017 5 1) (data read-all-from-file)
- (iterate
- (with maze = (coerce data 'simple-vector))
- (with bound = (1- (length maze)))
- (with address = 0)
- (for steps :from 0)
- (finding steps :such-that (not (<= 0 address bound)))
- (for offset = (aref maze address))
- (incf (aref maze address))
- (incf address offset)))
-
-(define-problem (2017 5 2) (data read-all-from-file)
- (iterate
- (with maze = (coerce data 'simple-vector))
- (with bound = (1- (length maze)))
- (with address = 0)
- (for steps :from 0)
- (finding steps :such-that (not (<= 0 address bound)))
- (for offset = (aref maze address))
- (incf (aref maze address)
- (if (>= offset 3) -1 1))
- (incf address offset)))
-
-
-(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)))
- (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)
- (summing 1 :into cycle)
- (redistribute)
- (for last-seen = (gethash banks seen))
- (until last-seen)
- (finally (return (values cycle (- cycle last-seen))))))))
-
-
-(define-problem (2017 7) (data read-lines-from-file)
- (labels
- ((parse-line (line)
- (ppcre:register-groups-bind
- (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
- (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
- (values name weight holding)))
- (insert-edge (digraph pred succ)
- (digraph:insert-vertex digraph pred)
- (digraph:insert-vertex digraph succ)
- (digraph:insert-edge digraph pred succ))
- (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))))))
- (multiple-value-bind (tower individual-weights) (build-tower data)
- (declare (ignore individual-weights))
- ;; (digraph.dot:draw tower)
- (first (digraph:roots tower)))))
--- a/src/2017/number-spiral.lisp Mon Dec 10 00:51:46 2018 -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))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/01.lisp Sat Dec 15 16:52:29 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))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/02.lisp Sat Dec 15 16:52:29 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)))))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/03.lisp Sat Dec 15 16:52:29 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))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/04.lisp Sat Dec 15 16:52:29 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)))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/05.lisp Sat Dec 15 16:52:29 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)))))
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/06.lisp Sat Dec 15 16:52:29 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))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/07.lisp Sat Dec 15 16:52:29 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)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/08.lisp Sat Dec 15 16:52:29 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))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/09.lisp Sat Dec 15 16:52:29 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)))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/10.lisp Sat Dec 15 16:52:29 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)))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/11.lisp Sat Dec 15 16:52:29 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)))))))
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2018/12.lisp Sat Dec 15 16:52:29 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)))))))
--- a/src/2018/main.lisp Mon Dec 10 00:51:46 2018 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,290 +0,0 @@
-(in-package :advent)
-(named-readtables:in-readtable :interpol-syntax)
-
-;;;; Problems -----------------------------------------------------------------
-(define-problem (2018 1 1) (data read-all-from-file)
- (summation data))
-
-(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)))
- (for number :in data)
- (summing number :into frequency)
- (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))))))
-
-(define-problem (2018 5) (data read-file-into-string)
- (setf data (remove #\newline data))
- (labels ((reactivep (x y)
- (char= x (char-invertcase y)))
- (react (string &aux result)
- (doseq (char string)
- (if (and result (reactivep char (car result)))
- (pop result)
- (push char result)))
- (coerce (nreverse result) 'string)))
- (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))))))
-
-
-(define-problem (2018 6) (data read-lines-from-file)
- (flet ((parse-line (line)
- (apply #'complex (mapcar #'parse-integer (str:split ", " line))))
- (closest (point coordinates)
- (let ((results (extremums coordinates '<
- :key (curry #'manhattan-distance point))))
- (case (length results)
- (1 (car results))
- (t nil)))))
- (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)))))))
-
-
-(define-problem (2018 7) (data read-lines-from-file)
- (labels ((parse-line (line)
- (ppcre:register-groups-bind
- (((rcurry #'aref 0) requirement target))
- (#?/Step (\w) must be finished before step (\w) can begin./ line)
- (list target requirement)))
- (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))
- (char-number (char)
- (1+ (- (char-code char) (char-code #\A))))
- (task-length (task)
- (+ 60 (char-number task)))
- (decrement-workers (workers)
- (gathering
- (do-array (worker workers)
- (when worker
- (when (zerop (decf (cdr worker)))
- (gather (car worker))
- (setf worker nil)))))))
- (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) conses,
- ;; or NILs for idle workers
- (with workers = (make-array 5 :initial-element nil))
- ;; (pr elapsed workers)
- (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))))))
-
-
-(define-problem (2018 8) (data)
- (labels
- ((make-node (children metadata) (cons metadata children))
- (children (node) (cdr node))
- (metadata (node) (car node))
- (read-node (stream)
- (let* ((children-count (read stream))
- (metadata-count (read stream))
- (children (iterate
- (repeat children-count)
- (collect (read-node stream) :result-type vector)))
- (metadata (iterate
- (repeat metadata-count)
- (collect (read stream)))))
- (make-node children metadata)))
- (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))))))))
- (let ((root (read-node data)))
- (values
- (recursively ((node root))
- (+ (summation (metadata node))
- (summation (children node) :key #'recur)))
- (node-value root)))))
-
-
-(define-problem (2018 9) (data read-file-into-string)
- (ppcre:register-groups-bind
- ((#'parse-integer players marbles))
- (#?/(\d+) players\D*(\d+) points/ data)
- (labels
- ((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 '>))))
- #+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/old/2015/2015.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,898 @@
+; https://bitbucket.org/sjl/beef
+(ql:quickload "beef")
+(ql:quickload "alexandria")
+(ql:quickload "split-sequence")
+(ql:quickload "cl-arrows")
+(ql:quickload "fset")
+(ql:quickload "cl-ppcre")
+(ql:quickload "ironclad")
+(ql:quickload "smug")
+(ql:quickload "bit-smasher")
+(ql:quickload "optima")
+
+(defpackage #:advent
+ (:use #:cl)
+ (:use #:cl-arrows)
+ (:use #:split-sequence)
+ (:use #:smug))
+
+(in-package #:advent)
+
+(declaim (optimize (debug 3)))
+
+;;;; Day 1
+(defun instruction-to-num (ch)
+ (cond
+ ((eql ch #\() 1)
+ ((eql ch #\)) -1)
+ (t 0)))
+
+(defun advent-1-1 ()
+ (loop :for c :across (beef:slurp "data/1")
+ :sum (instruction-to-num c)))
+
+(defun advent-1-2 ()
+ (loop :for c :across (beef:slurp "data/1")
+ :sum (instruction-to-num c) :into floor
+ :sum 1
+ :until (= floor -1)))
+
+
+;;;; Day 2
+(defun advent-2-data ()
+ (->> (beef:slurp "data/2")
+ beef:trim-whitespace-right
+ beef:split-lines
+ (mapcar (lambda (s)
+ (->> s
+ (split-sequence #\x)
+ (mapcar #'parse-integer))))))
+
+(defun advent-2-1 ()
+ (loop :for dims :in (advent-2-data)
+ :for (w h l) = dims
+ :for sides = (list (* w h)
+ (* w l)
+ (* h l))
+ :for paper = (* 2 (apply #'+ sides))
+ :for slack = (apply #'min sides)
+ :sum (+ paper slack)))
+
+(defun advent-2-2 ()
+ (loop :for dims :in (advent-2-data)
+ :for (w h l) = dims
+ :for sides = (list (* 2 (+ w h))
+ (* 2 (+ w l))
+ (* 2 (+ h l)))
+ :for ribbon = (apply #'min sides)
+ :for bow = (apply #'* dims)
+ :sum (+ ribbon bow)))
+
+
+;;;; Day 3
+(defun advent-3-data ()
+ (beef:trim-whitespace (beef:slurp "data/3")))
+
+(defun instruction-to-offsets (instruction)
+ (case instruction
+ (#\> '(1 0))
+ (#\< '(-1 0))
+ (#\^ '(0 1))
+ (#\v '(0 -1))))
+
+(defun step-santa (loc dir)
+ (destructuring-bind (x y) loc
+ (destructuring-bind (dx dy) (instruction-to-offsets dir)
+ (list (+ x dx) (+ y dy)))))
+
+(defun houses (data)
+ (loop
+ :with loc = '(0 0)
+ :with visited = (fset:set '(0 0))
+ :for dir :across data
+ :do (setq loc (step-santa loc dir))
+ :do (fset:includef visited loc)
+ :finally (return visited)))
+
+(defun advent-3-1 (data)
+ (fset:size (houses data)))
+
+(defun advent-3-2 (data)
+ (fset:size
+ (fset:union
+ ; come directly at me
+ (houses (ppcre:regex-replace-all "(.)." data "\\1"))
+ (houses (ppcre:regex-replace-all ".(.)" data "\\1")))))
+
+
+;;;; Day 4
+(defun advent-4-data ()
+ "ckczppom")
+
+(defun md5 (str)
+ (ironclad:byte-array-to-hex-string
+ (ironclad:digest-sequence :md5
+ (ironclad:ascii-string-to-byte-array str))))
+
+(defun mine (data zeroes)
+ (let ((target (apply #'concatenate 'string
+ (loop :repeat zeroes :collect "0"))))
+ (loop :for i :upfrom 1
+ :for hash = (->> i
+ prin1-to-string
+ (concatenate 'string data)
+ md5)
+ :until (equal target (subseq hash 0 zeroes))
+ :finally (return i))))
+
+(defun advent-4-1 (data)
+ (mine data 5))
+
+(defun advent-4-2 (data)
+ (mine data 6))
+
+
+;;;; Day 5
+(defun advent-5-data ()
+ (-> "data/5"
+ beef:slurp
+ beef:trim-whitespace-right
+ beef:split-lines))
+
+(defun join-strings (strings delim)
+ "Join strings into a single string with the given delimiter string interleaved.
+
+ Delim must not contain a ~.
+
+ "
+ (format nil (concatenate 'string "~{~A~^" delim "~}") strings))
+
+
+(defparameter *bad-pairs* '("ab" "cd" "pq" "xy"))
+
+(defun count-vowels (s)
+ (length (ppcre:regex-replace-all "[^aeiou]" s "")))
+
+(defun has-run (s)
+ (when (ppcre:scan "(.)\\1" s) t))
+
+(defun has-bad (s)
+ (when (ppcre:scan (join-strings *bad-pairs* "|") s) t))
+
+(defun is-nice (s)
+ (and (>= (count-vowels s) 3)
+ (has-run s)
+ (not (has-bad s))))
+
+(defun advent-5-1 (data)
+ (count-if #'is-nice data))
+
+(defun has-run-2 (s)
+ (when (ppcre:scan "(..).*\\1" s) t))
+
+(defun has-repeat (s)
+ (when (ppcre:scan "(.).\\1" s) t))
+
+(defun is-nice-2 (s)
+ (and (has-run-2 s)
+ (has-repeat s)))
+
+(defun advent-5-2 (data)
+ (count-if #'is-nice-2 data))
+
+
+;;;; Day 6
+(defun advent-6-data ()
+ (beef:slurp-lines "data/6" :ignore-trailing-newline t))
+
+(defmacro loop-array (arr name &rest body)
+ (let ((i (gensym "index")))
+ `(loop :for ,i :below (array-total-size ,arr)
+ :for ,name = (row-major-aref ,arr ,i)
+ ,@body)))
+
+(defun parse-indexes (s)
+ (->> s
+ (split-sequence #\,)
+ (mapcar #'parse-integer)))
+
+(defun flip (b)
+ (if (zerop b) 1 0))
+
+(defun parse-line (line)
+ (let ((parts (split-sequence #\space line)))
+ (list (parse-indexes (beef:index parts -3))
+ (parse-indexes (beef:index parts -1))
+ (cond
+ ((equal (car parts) "toggle") :toggle)
+ ((equal (cadr parts) "on") :on)
+ ((equal (cadr parts) "off") :off)
+ (t (error "Unknown operation!"))))))
+
+(defmacro loop-square (r c from-row from-col to-row to-col &rest body)
+ `(loop :for ,r :from ,from-row :to ,to-row
+ :do (loop :for ,c :from ,from-col :to ,to-col
+ ,@body)))
+
+(defun advent-6-1 (data)
+ (let ((lights (make-array '(1000 1000) :element-type 'bit)))
+ (loop
+ :for line :in data
+ :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+ :do (loop-square
+ r c from-row from-col to-row to-col
+ :do (setf (bit lights r c)
+ (case operation
+ (:toggle (flip (bit lights r c)))
+ (:on 1)
+ (:off 0)
+ (t 0)))))
+ (loop-array lights b
+ :sum b)))
+
+(defun advent-6-2 (data)
+ (let ((lights (make-array '(1000 1000) :element-type 'integer)))
+ (loop
+ :for line :in data
+ :for ((from-row from-col) (to-row to-col) operation) = (parse-line line)
+ :do (loop-square
+ r c from-row from-col to-row to-col
+ :do (case operation
+ (:toggle (incf (aref lights r c) 2))
+ (:on (incf (aref lights r c)))
+ (:off (when (not (zerop (aref lights r c)))
+ (decf (aref lights r c)))))))
+ (loop-array lights b
+ :sum b)))
+
+
+;;;; Day 7
+(defun advent-7-data ()
+ (beef:slurp-lines "data/7" :ignore-trailing-newline t))
+
+(defun advent-7-2-data ()
+ (beef:slurp-lines "data/7-2" :ignore-trailing-newline t))
+
+(defun int->bits (i)
+ (bitsmash:bits<- (format nil "~4,'0X" i)))
+
+(defun bit-lshift (bit-array distance)
+ (replace (make-array (length bit-array) :element-type 'bit)
+ bit-array
+ :start1 0
+ :start2 (bitsmash:int<- distance)))
+
+(defun bit-rshift (bit-array distance)
+ (let ((width (length bit-array))
+ (distance (bitsmash:int<- distance)))
+ (replace (make-array width :element-type 'bit)
+ bit-array
+ :start1 distance
+ :end2 (- width distance))))
+
+(defun .zero-or-more (parser)
+ (.plus (.let* ((x parser)
+ (xs (.zero-or-more parser)))
+ (.identity (cons x xs)))
+ (.identity ())))
+
+(defun .one-or-more (parser)
+ (.let* ((x parser)
+ (y (.zero-or-more parser)))
+ (.identity (cons x y))))
+
+(defun parse-7 (line)
+ (labels ((.whitespace ()
+ (.first (.one-or-more (.is 'member '(#\space #\tab)))))
+ (.arrow ()
+ (.first (.string= "->")))
+ (.number ()
+ (.let* ((digits (.first (.one-or-more (.is 'digit-char-p)))))
+ (.identity (parse-integer (concatenate 'string digits)))))
+ (.wire ()
+ (.let* ((chars (.first (.one-or-more (.is 'lower-case-p)))))
+ (.identity (concatenate 'string chars))))
+ (.source ()
+ (.or (.wire) (.number)))
+ (.string-choice (strs)
+ (if (not strs)
+ (.fail)
+ (.or (.string= (car strs))
+ (.string-choice (cdr strs)))))
+ (.dest ()
+ (.progn (.whitespace) (.arrow) (.whitespace)
+ (.wire)))
+ (.constant-source ()
+ (.let* ((val (.source)))
+ (.identity (list #'identity (list val)))))
+ (.binary-op ()
+ (let ((ops '(("AND" . bit-and)
+ ("OR" . bit-ior)
+ ("LSHIFT" . bit-lshift)
+ ("RSHIFT" . bit-rshift))))
+ (.let* ((name (.string-choice (mapcar #'car ops))))
+ (.identity (cdr (assoc name ops :test #'equal))))))
+ (.binary-source ()
+ (.let* ((left (.source))
+ (_ (.whitespace))
+ (op (.binary-op))
+ (_ (.whitespace))
+ (right (.source)))
+ (.identity (list op (list left right)))))
+ (.unary-op ()
+ (.let* ((_ (.string= "NOT")))
+ (.identity #'bit-not)))
+ (.unary-source ()
+ (.let* ((op (.unary-op))
+ (_ (.whitespace))
+ (source (.source)))
+ (.identity (list op (list source)))))
+ (.instruction ()
+ (.let* ((source (.or (.binary-source)
+ (.unary-source)
+ (.constant-source)))
+ (dest (.dest)))
+ (.identity (concatenate 'list source (list dest))))))
+ (parse (.instruction) line)))
+
+(defun advent-7-1 (data)
+ (let ((circuit (make-hash-table :test #'equal))
+ (commands (mapcar #'parse-7 data)))
+ (labels ((retrieve (source)
+ (cond
+ ((stringp source) (gethash source circuit))
+ ((integerp source) (int->bits source))
+ (t (error "what?"))))
+ (ready (args)
+ (every #'identity args))
+ (perform (fn args dest)
+ (setf (gethash dest circuit)
+ (apply fn args)))
+ (try-command (command)
+ "If the command is ready to go, run it and return nil. Otherwise,
+ return the command itself."
+ (destructuring-bind (fn args dest) command
+ (let ((vals (mapcar #'retrieve args)))
+ (if (ready vals)
+ (progn
+ (perform fn vals dest)
+ nil)
+ command)))))
+ (loop :while commands
+ :do (setf commands
+ (loop :for command :in commands
+ :when (try-command command)
+ :collect :it)))
+ (bitsmash:bits->int (gethash "a" circuit)))))
+
+
+;;;; Day 8
+(defun advent-8-data ()
+ (beef:slurp-lines "data/8" :ignore-trailing-newline t))
+
+
+(defconstant +backslash+ #\\ )
+(defconstant +quote+ #\" )
+
+(defun parse-8 (line)
+ (labels ((.hex-digit ()
+ (.or
+ (.is #'digit-char-p)
+ (.is #'member '(#\a #\b #\c #\d #\e #\f))))
+ (.hex-escape ()
+ (.let* ((_ (.char= #\x))
+ (a (.hex-digit))
+ (b (.hex-digit)))
+ (.identity
+ (->> (format nil "~A~A" a b)
+ bitsmash:hex->int
+ code-char))))
+ (.escaped-char ()
+ (.progn
+ (.char= +backslash+)
+ (.or (.char= +backslash+)
+ (.char= +quote+)
+ (.hex-escape))))
+ (.normal-char ()
+ (.is-not 'member (list +backslash+ +quote+)))
+ (.string-char ()
+ (.or (.normal-char)
+ (.escaped-char)))
+ (.full-string ()
+ (.prog2
+ (.char= +quote+)
+ (.first (.zero-or-more (.string-char)))
+ (.char= +quote+))))
+ (parse (.full-string) line)))
+
+(defun .wrap (fn parser)
+ (.let* ((v parser))
+ (.identity (funcall fn v))))
+
+(defun parse-8-2 (line)
+ (labels ((.special-char ()
+ (.let* ((ch (.or (.char= +backslash+)
+ (.char= +quote+))))
+ (.identity (list +backslash+ ch))))
+ (.normal-char ()
+ (.wrap #'list
+ (.is-not 'member (list +backslash+ +quote+))))
+ (.string-char ()
+ (.or (.normal-char)
+ (.special-char)))
+ (.full-string ()
+ (.let* ((chars (.zero-or-more (.string-char))))
+ (.identity (apply #'concatenate 'list chars)))))
+ (append (list +quote+)
+ (parse (.full-string) line)
+ (list +quote+))))
+
+(defun advent-8-1 (data)
+ (loop :for line :in data
+ :for chars = (parse-8 line)
+ :sum (- (length line)
+ (length chars))))
+
+(defun advent-8-2 (data)
+ (loop :for line :in data
+ :for chars = (parse-8-2 line)
+ :sum (- (length chars)
+ (length line))))
+
+
+;;;; Day 9
+(defun advent-9-data ()
+ (beef:slurp-lines "data/9" :ignore-trailing-newline t))
+
+; Thanks Norvig
+; http://norvig.com/paip/gps.lisp
+(defun permutations (bag)
+ "Return a list of all the permutations of the input."
+ ;; If the input is nil, there is only one permutation:
+ ;; nil itself
+ (if (null bag)
+ '(())
+ ;; Otherwise, take an element, e, out of the bag.
+ ;; Generate all permutations of the remaining elements,
+ ;; And add e to the front of each of these.
+ ;; Do this for all possible e to generate all permutations.
+ (mapcan #'(lambda (e)
+ (mapcar #'(lambda (p) (cons e p))
+ (permutations
+ (remove e bag :count 1 :test #'eq))))
+ bag)))
+
+(defun advent-9 (data)
+ (let ((distances (make-hash-table :test #'equal)))
+ (loop :for line :in data
+ :for (a to b _ dist) = (split-sequence #\space line)
+ :for distance = (parse-integer dist)
+ :do (progn
+ (setf (gethash (cons a b) distances) distance)
+ (setf (gethash (cons b a) distances) distance)))
+ (labels ((score-route (route)
+ (optima:match route
+ ((list _) 0)
+ ((list* a b _) (+ (gethash (cons a b) distances)
+ (score-route (cdr route))))))
+ (dedupe (l)
+ (remove-duplicates l :test #'equal)))
+ (loop :for route :in (->> distances
+ beef:hash-keys
+ (mapcar #'car)
+ dedupe
+ permutations)
+ :for score = (score-route route)
+ :minimizing score :into min-dist
+ :maximizing score :into max-dist
+ :finally (return (cons min-dist max-dist))))))
+
+
+(defmethod print-object ((object hash-table) stream)
+ (format stream "#HASH{~%~{~{ (~s : ~s)~}~%~}}"
+ (loop for key being the hash-keys of object
+ using (hash-value value)
+ collect (list key value))))
+
+
+;;;; Day 10
+(defun advent-10-data ()
+ "1321131112")
+
+(defun look-and-say (seq)
+ (let ((runs (list))
+ (len 1)
+ (current -1))
+ (flet ((mark-run ()
+ (setf runs (cons current (cons len runs)))))
+ (loop :for n :in seq
+ :do (if (= current n)
+ (incf len)
+ (progn
+ (when (not (= -1 current))
+ (mark-run))
+ (setf len 1)
+ (setf current n)))
+ :finally (mark-run))
+ (reverse runs))))
+
+(defun iterate (n f data)
+ (declare (optimize speed (debug 0)))
+ (dotimes (_ n)
+ (setf data (funcall f data)))
+ data)
+
+(defun las-to-list (s)
+ (loop :for digit :across s
+ :collect (-> digit string parse-integer)))
+
+(defun advent-10-1 (data)
+ (length (iterate 40 #'look-and-say (las-to-list data))))
+
+(defun advent-10-2 (data)
+ (length (iterate 50 #'look-and-say (las-to-list data))))
+
+
+;;;; Day 11
+(defun advent-11-data ()
+ "vzbxkghb")
+
+
+(defparameter base 26)
+(defparameter ascii-alpha-start (char-code #\a))
+(defun num-to-char (n)
+ (code-char (+ n ascii-alpha-start)))
+
+(defun char-to-num (ch)
+ (- (char-code ch) ascii-alpha-start))
+
+
+(defmacro loop-window (seq width binding-form &rest body)
+ (let ((i (gensym "IGNORE"))
+ (s (gensym "SEQ"))
+ (n (gensym "WIDTH"))
+ (tail (gensym "TAIL")))
+ `(let ((,s ,seq)
+ (,n ,width))
+ (loop :for ,i :upto (- (length ,s) ,n)
+ :for ,tail :on ,s
+ :for ,binding-form = (subseq ,tail 0 ,n)
+ ,@body))))
+
+
+(defun is-straight-3 (l)
+ (destructuring-bind (a b c) l
+ (and (= 1 (- b a))
+ (= 1 (- c b)))))
+
+(defun has-straight-3 (nums)
+ (loop-window nums 3 triplet
+ :thereis (is-straight-3 triplet)))
+
+
+(defparameter bad-chars
+ (mapcar #'char-to-num '(#\i #\l #\o)))
+
+(defun no-bad (nums)
+ (loop :for bad :in bad-chars
+ :never (find bad nums)))
+
+
+(defun two-pairs (nums)
+ (-> nums
+ (loop-window 2 (a b)
+ :when (= a b)
+ :collect a)
+ remove-duplicates
+ length
+ (>= 2)))
+
+
+(defun valid (nums)
+ (and (has-straight-3 nums)
+ (no-bad nums)
+ (two-pairs nums)
+ nums))
+
+
+(defun incr-nums (nums)
+ (labels ((inc-mod (x)
+ (mod (1+ x) base))
+ (inc (nums)
+ (if (not nums)
+ '(1)
+ (let ((head (inc-mod (car nums))))
+ (if (zerop head)
+ (cons head (inc (cdr nums)))
+ (cons head (cdr nums)))))))
+ (reverse (inc (reverse nums)))))
+
+
+(defun advent-11-1 (data)
+ (flet ((chars-to-string (chs)
+ (apply #'concatenate 'string (mapcar #'string chs)))
+ (nums-to-chars (nums)
+ (mapcar #'num-to-char nums))
+ (string-to-nums (str)
+ (loop :for ch :across str
+ :collect (char-to-num ch))))
+ (-> (loop :for pw = (incr-nums (string-to-nums data))
+ :then (incr-nums pw)
+ :thereis (valid pw))
+ nums-to-chars
+ chars-to-string)))
+
+
+;;;; Day 12
+(defun advent-12-data ()
+ (beef:trim-whitespace (beef:slurp "data/12")))
+
+
+(defun parse-json (s)
+ (labels ((.number ()
+ (.let* ((negation (.optional (.char= #\-)))
+ (digits (.first (.one-or-more (.is 'digit-char-p)))))
+ (.identity (let ((i (parse-integer (concatenate 'string digits)))
+ (c (if negation -1 1)))
+ (* i c)))))
+ (.string-char ()
+ (.wrap #'list (.is-not 'member (list +quote+))))
+ (.string-guts ()
+ (.let* ((chars (.zero-or-more (.string-char))))
+ (.identity (apply #'concatenate 'string chars))))
+ (.string ()
+ (.prog2
+ (.char= +quote+)
+ (.string-guts)
+ (.char= +quote+)))
+ (.map-pair ()
+ (.let* ((key (.string))
+ (_ (.char= #\:))
+ (value (.expression)))
+ (.identity (cons key value))))
+ (.map-guts ()
+ (.or
+ (.let* ((p (.map-pair))
+ (_ (.char= #\,))
+ (remaining (.map-guts)))
+ (.identity (cons p remaining)))
+ (.wrap #'list (.map-pair))
+ (.identity '())))
+ (.map ()
+ (.prog2
+ (.char= #\{)
+ (.wrap (lambda (v) (cons :map v))
+ (.map-guts))
+ (.char= #\})))
+ (.array-guts ()
+ (.or
+ (.let* ((item (.expression))
+ (_ (.char= #\,))
+ (remaining (.array-guts)))
+ (.identity (cons item remaining)))
+ (.wrap #'list (.expression))
+ (.identity '())))
+ (.array ()
+ (.prog2
+ (.char= #\[)
+ (.wrap (lambda (v) (cons :array v))
+ (.array-guts))
+ (.char= #\])))
+ (.expression ()
+ (.or (.array)
+ (.map)
+ (.string)
+ (.number))))
+ (parse (.expression) s)))
+
+(defun walk-sum (v)
+ (cond
+ ((not v) 0)
+ ((typep v 'integer) v)
+ ((typep v 'string) 0)
+ ((eql (car v) :array) (loop :for value in (cdr v)
+ :sum (walk-sum value)))
+ ((eql (car v) :map) (loop :for (key . value) :in (cdr v)
+ :sum (walk-sum value)))
+ (:else (error (format nil "wat? ~a" v)))))
+
+(defun walk-sum-2 (v)
+ (cond
+ ((not v) 0)
+ ((typep v 'integer) v)
+ ((typep v 'string) 0)
+ ((eql (car v) :array) (loop :for value in (cdr v)
+ :sum (walk-sum-2 value)))
+ ((eql (car v) :map)
+ (if (member "red" (mapcar #'cdr (cdr v))
+ :test #'equal)
+ 0
+ (loop :for (key . value) :in (cdr v)
+ :sum (walk-sum-2 value))))
+ (:else (error (format nil "wat? ~a" v)))))
+
+
+(defun advent-12-1 (data)
+ (walk-sum (parse-json data)))
+
+(defun advent-12-2 (data)
+ (walk-sum-2 (parse-json data)))
+
+
+;;;; Day 13
+(defun advent-13-data ()
+ (beef:slurp-lines "data/13" :ignore-trailing-newline t))
+
+
+(defvar *wat* nil)
+
+(defmacro map-when (test fn val &rest args)
+ (let ((v (gensym "VALUE")))
+ `(let ((,v ,val))
+ (if ,test
+ (apply ,fn ,v ,args)
+ ,v))))
+
+(defun split-lines-13 (lines)
+ (loop :for line :in lines
+ :collect (ppcre:register-groups-bind
+ (a dir amount b)
+ ("(\\w+) would (gain|lose) (\\d+) .*? next to (\\w+)."
+ line)
+ (list a b (map-when (equal "lose" dir)
+ #'-
+ (parse-integer amount))))))
+
+(defun rate-seating (vals arrangement)
+ (labels ((find-val (a b)
+ (or (gethash (cons a b) vals) 0))
+ (rate-one-direction (arr)
+ (+ (loop-window arr 2 (a b) :sum (find-val a b))
+ (find-val (car (last arr)) (car arr)))))
+ (+ (rate-one-direction arrangement)
+ (rate-one-direction (reverse arrangement)))))
+
+(defun advent-13-1 (data)
+ (let* ((tups (split-lines-13 data))
+ (attendees (remove-duplicates (mapcar #'car tups) :test #'equal))
+ (vals (make-hash-table :test #'equal)))
+ (loop :for (a b val) :in tups
+ :do (setf (gethash (cons a b) vals) val))
+ (loop :for arrangement :in (permutations attendees)
+ :maximize (rate-seating vals arrangement))))
+
+(defun advent-13-2 (data)
+ (let* ((tups (split-lines-13 data))
+ (attendees (cons "Self" (remove-duplicates (mapcar #'car tups) :test #'equal)))
+ (vals (make-hash-table :test #'equal)))
+ (loop :for (a b val) :in tups
+ :do (setf (gethash (cons a b) vals) val))
+ (loop :for arrangement :in (permutations attendees)
+ :maximize (rate-seating vals arrangement))))
+
+
+;;;; Day 14
+(defun advent-14-data ()
+ (beef:slurp-lines "data/14" :ignore-trailing-newline t))
+
+
+(defun tick (deer)
+ (destructuring-bind
+ (name speed sprint-period rest-period traveled currently remaining)
+ deer
+ (let ((remaining (1- remaining)))
+ (if (equal currently :resting)
+ (list name speed sprint-period rest-period
+ traveled
+ (if (zerop remaining) :sprinting :resting)
+ (if (zerop remaining) sprint-period remaining))
+ (list name speed sprint-period rest-period
+ (+ traveled speed)
+ (if (zerop remaining) :resting :sprinting)
+ (if (zerop remaining) rest-period remaining))))))
+
+(defun parse-deers (lines)
+ (loop :for line :in lines
+ :collect (ppcre:register-groups-bind
+ (name speed sprint-period rest-period)
+ ("(\\w+) can fly (\\d+) km/s for (\\d+) .* (\\d+) seconds."
+ line)
+ (list name
+ (parse-integer speed)
+ (parse-integer sprint-period)
+ (parse-integer rest-period)
+ 0
+ :sprinting
+ (parse-integer sprint-period)))))
+
+(defun find-leaders (deers)
+ (let ((dist (reduce #'max deers :key (beef:partial #'nth 4))))
+ (remove-if-not (lambda (deer)
+ (= dist (nth 4 deer)))
+ deers)))
+
+
+(defun advent-14-1 (data n)
+ (apply #'max
+ (loop :for i :upto n
+ :for deers := (parse-deers data) :then (mapcar #'tick deers)
+ :finally (return (mapcar (beef:partial #'nth 4) deers)))))
+
+(defun advent-14-2 (data n)
+ (let ((scores (make-hash-table :test #'equal))
+ (deers (parse-deers data)))
+ (loop :for (name) :in deers
+ :do (setf (gethash name scores) 0))
+ (loop :for i :upto n
+ :do (setf deers (mapcar #'tick deers))
+ :do (loop :for (name) :in (find-leaders deers)
+ :do (incf (gethash name scores))))
+ (apply #'max (beef:hash-values scores))))
+
+
+
+;;;; Day 15
+(defun advent-15-data ()
+ (beef:slurp-lines "data/15" :ignore-trailing-newline t))
+
+(defun split-ingredients (line)
+ (ppcre:register-groups-bind
+ (name (#'parse-integer capacity durability flavor texture calories))
+ ("(\\w+): capacity (-?\\d+), durability (-?\\d+), flavor (-?\\d+), texture (-?\\d+), calories (-?\\d+)"
+ line)
+ (list name capacity durability flavor texture calories)))
+
+(defun calc-contribution (ingr amount)
+ (cons (car ingr)
+ (mapcar (beef:partial #'* amount)
+ (cdr ingr))))
+
+(defun calc-contributions (ingrs alist)
+ (mapcar #'calc-contribution ingrs alist))
+
+(defun sum-totals (ingrs)
+ (->> ingrs
+ (mapcar #'cdr)
+ (apply #'mapcar #'+)
+ (mapcar (lambda (x) (if (< x 0) 0 x)))))
+
+(defun advent-15-1 (data)
+ (let ((ingredients (mapcar #'split-ingredients data))
+ (limit 100)
+ (amounts (list)))
+ ; fuckin lol
+ (loop :for a :upto limit :do
+ (loop :for b :upto (- limit a) :do
+ (loop :for c :upto (- limit a b) :do
+ (setf amounts
+ (cons (list a b c (- limit a b c))
+ amounts)))))
+ (loop :for alist :in amounts
+ :maximize (->> alist
+ (calc-contributions ingredients)
+ sum-totals
+ butlast
+ (apply #'*)))))
+
+(defun advent-15-2 (data)
+ (let ((ingredients (mapcar #'split-ingredients data))
+ (limit 100)
+ (amounts (list)))
+ ; fuckin lol
+ (loop :for a :upto limit :do
+ (loop :for b :upto (- limit a) :do
+ (loop :for c :upto (- limit a b) :do
+ (setf amounts
+ (cons (list a b c (- limit a b c))
+ amounts)))))
+ (loop :for alist :in amounts
+ :for val = (->> alist
+ (calc-contributions ingredients)
+ sum-totals)
+ :when (= (car (last val)) 500)
+ :maximize (apply #'* (butlast val)))))
+
+
+;;;; Scratch
+#+comment
+(advent-15-2 (advent-15-data))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/old/2017/main.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -0,0 +1,155 @@
+(in-package :advent)
+(named-readtables:in-readtable :interpol-syntax)
+
+
+(define-problem (2017 1 1) (data read-file-of-digits)
+ (iterate
+ (for (x . y) :pairs-of-list data)
+ (when (= x y)
+ (sum x))))
+
+(define-problem (2017 1 2) (data read-file-of-digits)
+ (iterate
+ (with data = (coerce data 'vector))
+ (with length = (length data))
+ (for x :in-vector data)
+ (for iy :modulo length :from (truncate length 2))
+ (for y = (aref data iy))
+ (when (= x y)
+ (sum x))))
+
+
+(define-problem (2017 2 1) (data read-file-of-lines-of-numbers)
+ (flet ((checksum (line)
+ (- (extremum line #'>)
+ (extremum line #'<))))
+ (summation data :key #'checksum)))
+
+(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)
+ (destructuring-bind (n . remaining) list
+ (some (curry #'validp n) remaining)))
+ (checksum (line)
+ (somelist #'head-valid-p line)))
+ (summation data :key #'checksum)))
+
+
+(define-problem (2017 3 1) (data read-form-from-file)
+ (labels ((manhattan-distance (a b)
+ (+ (abs (- (realpart a)
+ (realpart b)))
+ (abs (- (imagpart a)
+ (imagpart b)))))
+ (distance-to-origin (p)
+ (manhattan-distance #c(0 0) p)))
+ (distance-to-origin (advent.spiral:number-coordinates data))))
+
+(define-problem (2017 3 2) (data read-form-from-file)
+ (flet ((neighbors (coord)
+ (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 data))
+ (setf (gethash coord memory) value))))
+
+
+(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 data)))
+
+(define-problem (2017 4 2) (data read-file-of-lines-of-words)
+ (labels ((anagramp (string1 string2)
+ (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 data)))
+
+
+(define-problem (2017 5 1) (data read-all-from-file)
+ (iterate
+ (with maze = (coerce data 'simple-vector))
+ (with bound = (1- (length maze)))
+ (with address = 0)
+ (for steps :from 0)
+ (finding steps :such-that (not (<= 0 address bound)))
+ (for offset = (aref maze address))
+ (incf (aref maze address))
+ (incf address offset)))
+
+(define-problem (2017 5 2) (data read-all-from-file)
+ (iterate
+ (with maze = (coerce data 'simple-vector))
+ (with bound = (1- (length maze)))
+ (with address = 0)
+ (for steps :from 0)
+ (finding steps :such-that (not (<= 0 address bound)))
+ (for offset = (aref maze address))
+ (incf (aref maze address)
+ (if (>= offset 3) -1 1))
+ (incf address offset)))
+
+
+(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)))
+ (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)
+ (summing 1 :into cycle)
+ (redistribute)
+ (for last-seen = (gethash banks seen))
+ (until last-seen)
+ (finally (return (values cycle (- cycle last-seen))))))))
+
+
+(define-problem (2017 7) (data read-lines-from-file)
+ (labels
+ ((parse-line (line)
+ (ppcre:register-groups-bind
+ (name (#'parse-integer weight) ((curry #'str:split ", ") holding))
+ (#?/(\w+) \((\d+)\)(?: -> (.+))?/ line)
+ (values name weight holding)))
+ (insert-edge (digraph pred succ)
+ (digraph:insert-vertex digraph pred)
+ (digraph:insert-vertex digraph succ)
+ (digraph:insert-edge digraph pred succ))
+ (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))))))
+ (multiple-value-bind (tower individual-weights) (build-tower data)
+ (declare (ignore individual-weights))
+ ;; (digraph.dot:draw tower)
+ (first (digraph:roots tower)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/old/2017/number-spiral.lisp Sat Dec 15 16:52:29 2018 -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/utils.lisp Mon Dec 10 00:51:46 2018 -0500
+++ b/src/utils.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -1,60 +1,85 @@
(in-package :advent)
+;;;; Clipboard ----------------------------------------------------------------
+(defun sh (command &key (input "") output)
+ (uiop:run-program command
+ :output (when output :string)
+ :input (make-string-input-stream input)))
+
+(defun pbcopy (object)
+ (sh '("pbcopy") :input (aesthetic-string object))
+ (values))
+
+(defun pbpaste ()
+ (values (sh '("pbpaste") :output t)))
+
+
+;;;; Streams ------------------------------------------------------------------
+(defun ensure-stream (input)
+ (ctypecase input
+ (stream input)
+ (string (make-string-input-stream input))))
+
+(defun ensure-string (input)
+ (ctypecase input
+ (stream (alexandria:read-stream-content-into-string input))
+ (string (copy-seq input))))
+
+
;;;; Problems -----------------------------------------------------------------
-(defmacro define-problem ((year day &optional part)
- (data-symbol &optional reader)
+(defmacro define-problem ((year day)
+ (arg &optional (reader 'identity))
&body body)
- (let ((function-name (if part
- (symb 'advent- year '- day '/ part)
- (symb 'advent- year '- day)))
- (path (format nil "data/~D/~2,'0D.txt" year day)))
- `(defun ,function-name ()
- ,(if (null reader)
- `(with-open-file (,data-symbol ,path)
- ,@body)
- `(let ((,data-symbol (,reader ,path)))
- ,@body)))))
+ (multiple-value-bind (body declarations docstring)
+ (alexandria:parse-body body :documentation t)
+ (with-gensyms (file)
+ (let ((run (symb 'run)))
+ `(defun ,run (&optional ,arg)
+ ,@(when docstring (list docstring))
+ ,@declarations
+ (let ((,file (unless ,arg (open (problem-data-path ,year ,day)))))
+ (unwind-protect
+ (progn (setf ,arg (,reader (ensure-stream (or ,arg ,file))))
+ ,@body)
+ (when ,file (close ,file)))))))))
+
+(defun problem-data-path (year day)
+ (make-pathname
+ :directory `(:relative "data" ,(aesthetic-string year))
+ :name (format nil "~2,'0D" day)
+ :type "txt"))
;;;; Readers ------------------------------------------------------------------
-(defun read-form-from-file (path)
- "Read the first form from `path`."
- (with-open-file (s path)
- (read s)))
-
-(defun read-lines-from-file (path)
- "Read the lines in `path` into a list of strings."
- (iterate (for line :in-file path :using #'read-line)
- (collect line)))
+(defun read-numbers-from-line (line)
+ (mapcar #'parse-integer (ppcre:all-matches-as-strings "-?\\d+" line)))
-(defun read-file-of-digits (path)
- "Read all the ASCII digits in `path` into a list of integers.
+(defun read-and-collect (stream reader)
+ (iterate (for value :in-stream stream :using reader)
+ (collect value)))
+
+(defun read-all (stream)
+ "Read all forms from `stream` and return them as a fresh list."
+ (read-and-collect stream #'read))
- Any character in the file that's not an ASCII digit will be silently ignored.
+(defun read-lines (stream)
+ "Read all lines from `stream` and return them as a fresh list of strings."
+ (read-and-collect stream #'read-line))
+
+(defun read-lines-of-numbers-and-garbage (stream)
+ "Read the lines of numbers in `stream` into a list of lists of numbers.
+
+ Numbers can be separated by anything, even garbage.
+
+ Lines without any numbers will be discarded.
"
- (-<> 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)))
+ (iterate (for line :in-stream stream :using #'read-line)
+ (for numbers = (read-numbers-from-line 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))))
-
;;;; Rings --------------------------------------------------------------------
(declaim (inline ring-prev ring-next ring-data))
@@ -292,3 +317,23 @@
(defmethod emptyp ((hset hash-set))
(hset-empty-p hset))
+
+
+(defun-inline nth-digit (n integer &optional (radix 10))
+ "Return the `n`th digit of `integer` in base `radix`, counting from the right."
+ (mod (truncate integer (expt radix n)) radix))
+
+(defun-inlineable integral-image (width height value-function)
+ ;; https://en.wikipedia.org/wiki/Summed-area_table
+ (let ((image (make-array (list width height)))
+ (last-row (1- height))
+ (last-col (1- width)))
+ (dotimes (x width)
+ (dotimes (y height)
+ (setf (aref image x y)
+ (+ (funcall value-function x y)
+ (if (= x last-col) 0 (aref image (1+ x) y))
+ (if (= y last-row) 0 (aref image x (1+ y)))
+ (if (or (= x last-col) (= y last-row))
+ 0
+ (- (aref image (1+ x) (1+ y))))))))))
--- a/vendor/make-quickutils.lisp Mon Dec 10 00:51:46 2018 -0500
+++ b/vendor/make-quickutils.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -7,16 +7,18 @@
:compose
:copy-hash-table
:curry
+ :deletef
:ensure-gethash
:extremum
:flatten-once
:hash-table-keys
:hash-table-values
- :with-gensyms
:once-only
:rcurry
:read-file-into-string
+ :removef
:symb
+ :with-gensyms
)
:package "ADVENT.QUICKUTILS")
--- a/vendor/quickutils.lisp Mon Dec 10 00:51:46 2018 -0500
+++ b/vendor/quickutils.lisp Sat Dec 15 16:52:29 2018 -0500
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :WITH-GENSYMS :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :DELETEF :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SYMB :WITH-GENSYMS) :ensure-package T :package "ADVENT.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "ADVENT.QUICKUTILS")
@@ -15,13 +15,13 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
:COMPOSE :COPY-HASH-TABLE :CURRY
- :ENSURE-GETHASH :EXTREMUM
+ :DELETEF :ENSURE-GETHASH :EXTREMUM
:FLATTEN-ONCE :MAPHASH-KEYS
:HASH-TABLE-KEYS :MAPHASH-VALUES
- :HASH-TABLE-VALUES :STRING-DESIGNATOR
- :WITH-GENSYMS :ONCE-ONLY :RCURRY
+ :HASH-TABLE-VALUES :ONCE-ONLY :RCURRY
:WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
- :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+ :READ-FILE-INTO-STRING :REMOVEF :MKSTR
+ :SYMB :STRING-DESIGNATOR :WITH-GENSYMS))))
(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`,
@@ -118,6 +118,16 @@
(apply ,fun ,@curries more)))))
+ (declaim (inline delete/swapped-arguments))
+ (defun delete/swapped-arguments (sequence item &rest keyword-arguments)
+ (apply #'delete item sequence keyword-arguments))
+
+ (define-modify-macro deletef (item &rest remove-keywords)
+ delete/swapped-arguments
+ "Modify-macro for `delete`. Sets place designated by the first argument to
+the result of calling `delete` with `item`, place, and the `keyword-arguments`.")
+
+
(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
@@ -217,50 +227,6 @@
values))
- (deftype string-designator ()
- "A string designator type. A string designator is either a string, a symbol,
-or a character."
- `(or symbol string character))
-
-
- (defmacro with-gensyms (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(let ,(mapcar (lambda (name)
- (multiple-value-bind (symbol string)
- (etypecase name
- (symbol
- (values name (symbol-name name)))
- ((cons symbol (cons string-designator null))
- (values (first name) (string (second name)))))
- `(,symbol (gensym ,string))))
- names)
- ,@forms))
-
- (defmacro with-unique-names (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(with-gensyms ,names ,@forms))
-
-
(defmacro once-only (specs &body forms)
"Evaluates `forms` with symbols specified in `specs` rebound to temporary
variables, ensuring that each initform is evaluated only once.
@@ -362,6 +328,16 @@
:while (= bytes-read buffer-size)))))))
+ (declaim (inline remove/swapped-arguments))
+ (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
+ (apply #'remove item sequence keyword-arguments))
+
+ (define-modify-macro removef (item &rest remove-keywords)
+ remove/swapped-arguments
+ "Modify-macro for `remove`. Sets place designated by the first argument to
+the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
+
+
(defun mkstr (&rest args)
"Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
@@ -378,9 +354,53 @@
See also: `symbolicate`"
(values (intern (apply #'mkstr args))))
+
+ (deftype string-designator ()
+ "A string designator type. A string designator is either a string, a symbol,
+or a character."
+ `(or symbol string character))
+
+
+ (defmacro with-gensyms (names &body forms)
+ "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+ (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+ (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+ `(let ,(mapcar (lambda (name)
+ (multiple-value-bind (symbol string)
+ (etypecase name
+ (symbol
+ (values name (symbol-name name)))
+ ((cons symbol (cons string-designator null))
+ (values (first name) (string (second name)))))
+ `(,symbol (gensym ,string))))
+ names)
+ ,@forms))
+
+ (defmacro with-unique-names (names &body forms)
+ "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+ (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+ (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+ `(with-gensyms ,names ,@forms))
+
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose copy-hash-table curry ensure-gethash extremum flatten-once
- hash-table-keys hash-table-values with-gensyms with-unique-names
- once-only rcurry read-file-into-string symb)))
+ (export '(compose copy-hash-table curry deletef ensure-gethash extremum
+ flatten-once hash-table-keys hash-table-values once-only rcurry
+ read-file-into-string removef symb with-gensyms with-unique-names)))
;;;; END OF quickutils.lisp ;;;;