182bdd87fd9e
Refactor, remove quickutil
Changes
--- a/.lispwords Sun Dec 15 13:14:04 2019 -0500 +++ b/.lispwords Mon Nov 29 23:19:14 2021 -0500 @@ -4,3 +4,4 @@ (1 finding-first) (1 rebind) (1 drawing-screen) +(1 print-hash-table-map)
--- a/Makefile Sun Dec 15 13:14:04 2019 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -.PHONY: vendor - -# Vendor ---------------------------------------------------------------------- -vendor/quickutils.lisp: vendor/make-quickutils.lisp - cd vendor && sbcl --noinform --load make-quickutils.lisp --eval '(quit)' - -vendor: vendor/quickutils.lisp
--- a/advent.asd Sun Dec 15 13:14:04 2019 -0500 +++ b/advent.asd Mon Nov 29 23:19:14 2021 -0500 @@ -39,10 +39,7 @@ ) :serial t - :components ((:module "vendor" :serial t - :components ((:file "quickutils-package") - (:file "quickutils"))) - (:file "package") + :components ((:file "package") (:module "src" :serial t :components ((:file "utils") (:module "2016" :serial t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/data/2019/16.txt Mon Nov 29 23:19:14 2021 -0500 @@ -0,0 +1,1 @@ +59715091976660977847686180472178988274868874248912891927881770506416128667679122958792624406231072013221126623881489317912309763385182133601840446469164152094801911846572235367585363091944153574934709408511688568362508877043643569519630950836699246046286262479407806494008328068607275931633094949344281398150800187971317684501113191184838118850287189830872128812188237680673513745269645219228183633986701871488467284716433953663498444829748364402022393727938781357664034739772457855166471802886565257858813291667525635001823584650420815316132943869499800374997777130755842319153463895364409226260937941771665247483191282218355610246363741092810592458
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/data/2019/17.txt Mon Nov 29 23:19:14 2021 -0500 @@ -0,0 +1,1 @@ +1,330,331,332,109,4718,1101,0,1182,16,1101,1469,0,24,101,0,0,570,1006,570,36,101,0,571,0,1001,570,-1,570,1001,24,1,24,1106,0,18,1008,571,0,571,1001,16,1,16,1008,16,1469,570,1006,570,14,21102,58,1,0,1106,0,786,1006,332,62,99,21101,333,0,1,21101,0,73,0,1105,1,579,1102,1,0,572,1101,0,0,573,3,574,101,1,573,573,1007,574,65,570,1005,570,151,107,67,574,570,1005,570,151,1001,574,-64,574,1002,574,-1,574,1001,572,1,572,1007,572,11,570,1006,570,165,101,1182,572,127,101,0,574,0,3,574,101,1,573,573,1008,574,10,570,1005,570,189,1008,574,44,570,1006,570,158,1105,1,81,21101,0,340,1,1106,0,177,21102,477,1,1,1105,1,177,21101,0,514,1,21102,176,1,0,1105,1,579,99,21102,184,1,0,1106,0,579,4,574,104,10,99,1007,573,22,570,1006,570,165,1001,572,0,1182,21102,375,1,1,21102,211,1,0,1106,0,579,21101,1182,11,1,21101,222,0,0,1106,0,979,21102,388,1,1,21101,233,0,0,1105,1,579,21101,1182,22,1,21101,244,0,0,1106,0,979,21101,0,401,1,21101,255,0,0,1106,0,579,21101,1182,33,1,21102,1,266,0,1105,1,979,21101,0,414,1,21101,0,277,0,1105,1,579,3,575,1008,575,89,570,1008,575,121,575,1,575,570,575,3,574,1008,574,10,570,1006,570,291,104,10,21102,1,1182,1,21101,313,0,0,1106,0,622,1005,575,327,1101,1,0,575,21101,0,327,0,1105,1,786,4,438,99,0,1,1,6,77,97,105,110,58,10,33,10,69,120,112,101,99,116,101,100,32,102,117,110,99,116,105,111,110,32,110,97,109,101,32,98,117,116,32,103,111,116,58,32,0,12,70,117,110,99,116,105,111,110,32,65,58,10,12,70,117,110,99,116,105,111,110,32,66,58,10,12,70,117,110,99,116,105,111,110,32,67,58,10,23,67,111,110,116,105,110,117,111,117,115,32,118,105,100,101,111,32,102,101,101,100,63,10,0,37,10,69,120,112,101,99,116,101,100,32,82,44,32,76,44,32,111,114,32,100,105,115,116,97,110,99,101,32,98,117,116,32,103,111,116,58,32,36,10,69,120,112,101,99,116,101,100,32,99,111,109,109,97,32,111,114,32,110,101,119,108,105,110,101,32,98,117,116,32,103,111,116,58,32,43,10,68,101,102,105,110,105,116,105,111,110,115,32,109,97,121,32,98,101,32,97,116,32,109,111,115,116,32,50,48,32,99,104,97,114,97,99,116,101,114,115,33,10,94,62,118,60,0,1,0,-1,-1,0,1,0,0,0,0,0,0,1,28,8,0,109,4,2102,1,-3,586,21002,0,1,-1,22101,1,-3,-3,21101,0,0,-2,2208,-2,-1,570,1005,570,617,2201,-3,-2,609,4,0,21201,-2,1,-2,1105,1,597,109,-4,2105,1,0,109,5,1201,-4,0,630,20101,0,0,-2,22101,1,-4,-4,21101,0,0,-3,2208,-3,-2,570,1005,570,781,2201,-4,-3,653,20101,0,0,-1,1208,-1,-4,570,1005,570,709,1208,-1,-5,570,1005,570,734,1207,-1,0,570,1005,570,759,1206,-1,774,1001,578,562,684,1,0,576,576,1001,578,566,692,1,0,577,577,21101,702,0,0,1105,1,786,21201,-1,-1,-1,1106,0,676,1001,578,1,578,1008,578,4,570,1006,570,724,1001,578,-4,578,21102,1,731,0,1106,0,786,1105,1,774,1001,578,-1,578,1008,578,-1,570,1006,570,749,1001,578,4,578,21101,756,0,0,1105,1,786,1106,0,774,21202,-1,-11,1,22101,1182,1,1,21102,1,774,0,1105,1,622,21201,-3,1,-3,1105,1,640,109,-5,2106,0,0,109,7,1005,575,802,20101,0,576,-6,20102,1,577,-5,1106,0,814,21102,0,1,-1,21101,0,0,-5,21101,0,0,-6,20208,-6,576,-2,208,-5,577,570,22002,570,-2,-2,21202,-5,57,-3,22201,-6,-3,-3,22101,1469,-3,-3,1201,-3,0,843,1005,0,863,21202,-2,42,-4,22101,46,-4,-4,1206,-2,924,21101,0,1,-1,1106,0,924,1205,-2,873,21101,0,35,-4,1105,1,924,1202,-3,1,878,1008,0,1,570,1006,570,916,1001,374,1,374,2101,0,-3,895,1101,2,0,0,1201,-3,0,902,1001,438,0,438,2202,-6,-5,570,1,570,374,570,1,570,438,438,1001,578,558,921,21001,0,0,-4,1006,575,959,204,-4,22101,1,-6,-6,1208,-6,57,570,1006,570,814,104,10,22101,1,-5,-5,1208,-5,57,570,1006,570,810,104,10,1206,-1,974,99,1206,-1,974,1101,0,1,575,21101,973,0,0,1106,0,786,99,109,-7,2106,0,0,109,6,21102,0,1,-4,21101,0,0,-3,203,-2,22101,1,-3,-3,21208,-2,82,-1,1205,-1,1030,21208,-2,76,-1,1205,-1,1037,21207,-2,48,-1,1205,-1,1124,22107,57,-2,-1,1205,-1,1124,21201,-2,-48,-2,1105,1,1041,21102,1,-4,-2,1106,0,1041,21102,-5,1,-2,21201,-4,1,-4,21207,-4,11,-1,1206,-1,1138,2201,-5,-4,1059,1201,-2,0,0,203,-2,22101,1,-3,-3,21207,-2,48,-1,1205,-1,1107,22107,57,-2,-1,1205,-1,1107,21201,-2,-48,-2,2201,-5,-4,1090,20102,10,0,-1,22201,-2,-1,-2,2201,-5,-4,1103,2101,0,-2,0,1105,1,1060,21208,-2,10,-1,1205,-1,1162,21208,-2,44,-1,1206,-1,1131,1105,1,989,21102,1,439,1,1105,1,1150,21101,477,0,1,1106,0,1150,21102,1,514,1,21102,1,1149,0,1106,0,579,99,21102,1,1157,0,1106,0,579,204,-2,104,10,99,21207,-3,22,-1,1206,-1,1138,1201,-5,0,1176,2102,1,-4,0,109,-6,2106,0,0,18,7,50,1,5,1,50,1,5,1,50,1,5,1,50,1,5,1,50,1,5,1,50,1,5,1,50,1,5,1,50,11,19,9,24,1,23,1,7,1,24,13,11,1,7,1,36,1,11,1,7,1,36,1,11,1,7,1,36,1,11,1,7,1,36,1,9,11,36,1,9,1,1,1,44,1,9,1,1,1,44,1,9,1,1,1,44,13,54,1,56,1,56,1,56,1,56,1,56,1,56,1,48,9,48,1,56,1,56,1,56,1,56,1,56,1,56,1,28,9,19,1,28,1,7,1,19,1,28,1,7,1,19,1,28,1,7,1,19,1,28,1,7,1,19,11,18,1,7,1,29,1,16,13,1,1,25,1,16,1,1,1,7,1,1,1,1,1,25,1,16,1,1,1,7,11,19,1,16,1,1,1,9,1,1,1,5,1,19,1,8,11,9,1,1,1,5,1,19,1,8,1,7,1,11,1,1,1,5,1,19,1,8,1,7,1,11,1,1,1,5,1,11,9,8,1,7,1,11,1,1,1,5,1,11,1,16,1,7,1,11,13,7,1,16,1,7,1,13,1,5,1,3,1,7,1,16,9,13,7,3,1,7,1,48,1,7,1,48,1,7,1,48,1,7,1,48,1,7,1,48,1,7,1,48,9,16
--- a/package.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/package.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,5 +1,5 @@ (defpackage :advent - (:use :cl :losh :iterate :advent.quickutils) + (:use :cl :losh :iterate) (:export :define-problem @@ -13,6 +13,7 @@ :read-2d-array :read-before :read-to + :read-digits :ensure-string :ensure-stream @@ -29,6 +30,7 @@ :integral-range :manhattan-distance :manhattan-neighbors + :manhattan-neighborhood :x :y :nth-digit @@ -36,6 +38,7 @@ :positions :positions-if :digits + :digits-to-number :fresh-vector :first-character :let-result @@ -88,5 +91,3 @@ )) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *advent-use* '(:use :cl :losh :iterate :advent :advent.quickutils)))
--- a/src/2016/days/day-01.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-01.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/01 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/01) (in-package :advent/2016/01)
--- a/src/2016/days/day-02.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-02.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/02 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/02) (in-package :advent/2016/02) (defparameter *pad* 1)
--- a/src/2016/days/day-03.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-03.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/03 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/03) (in-package :advent/2016/03) (defun validp (a b c)
--- a/src/2016/days/day-04.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-04.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/04 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/04) (in-package :advent/2016/04) (defun sort-predicate (a b) @@ -9,21 +9,21 @@ (t (char< ach bch)))))) (defun checksum (name) - (-<> name - (remove #\- <>) + (_ name + (remove #\- _) frequencies alexandria:hash-table-alist - (sort <> #'sort-predicate) - (take 5 <>) - (map 'string #'car <>))) + (sort _ #'sort-predicate) + (take 5 _) + (map 'string #'car _))) (defun rot (char n) - (-<> char + (_ char char-code - (- <> (char-code #\a)) - (+ <> n) - (mod <> 26) - (+ <> (char-code #\a)) + (- _ (char-code #\a)) + (+ _ n) + (mod _ 26) + (+ _ (char-code #\a)) code-char)) (defun decrypt-char (char id)
--- a/src/2016/days/day-05.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-05.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/05 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/05) (in-package :advent/2016/05) (defparameter *fancy* nil)
--- a/src/2016/days/day-06.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-06.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/06 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/06) (in-package :advent/2016/06) (defun freqs (lines)
--- a/src/2016/days/day-07.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-07.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/07 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/07) (in-package :advent/2016/07) (defun read-word (stream) @@ -48,7 +48,7 @@ (for aba :in (mapcan #'find-babs supers)) (finding t :such-that (tree-find-if (curry #'str:containsp aba) hypers)))) -(define-problem (2016 7) (data read-lines) (115) +(define-problem (2016 7) (data read-lines) (115 231) (values (count-if #'tlsp data :key #'parse-address) (count-if #'sslp data :key #'parse-address)))
--- a/src/2016/days/day-08.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-08.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/08 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/08) (in-package :advent/2016/08) (defun make-screen ()
--- a/src/2016/days/day-09.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-09.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2016/09 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2016/09) (in-package :advent/2016/09)
--- a/src/2016/days/day-10.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2016/days/day-10.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,6 +1,23 @@ -(advent:defpackage* :advent/2016/09) -(in-package :advent/2016/09) +(advent:defpackage* :advent/2016/10) +(in-package :advent/2016/10) +(defun tree-collect (predicate tree) ; todo from quickutil, remove this + "Returns a list of every node in the `tree` that satisfies the `predicate`. If there are any improper lists in the tree, the `predicate` is also applied to their dotted elements." + (let ((sentinel (gensym))) + (flet ((my-cdr (obj) + (cond ((consp obj) + (let ((result (cdr obj))) + (if (listp result) + result + (list result sentinel)))) + (t + (list sentinel))))) + (loop :for (item . rest) :on tree :by #'my-cdr + :until (eq item sentinel) + :if (funcall predicate item) collect item + :else + :if (listp item) + :append (tree-collect predicate item))))) (defun parse-line (line) (or (ppcre:register-groups-bind @@ -20,7 +37,7 @@ (tree-collect (lambda (node) (and (consp node) (eql (car node) type))) _) - (extremum _ #'> :key #'cdr) + (alexandria:extremum _ #'> :key #'cdr) (1+ (cdr _))) :initial-element nil))
--- a/src/2017/days/day-01.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-01.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/01 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/01) (in-package :advent/2017/01)
--- a/src/2017/days/day-02.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-02.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/02 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/02) (in-package :advent/2017/02) (defun find-quotient (row)
--- a/src/2017/days/day-03.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-03.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/03 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/03) (in-package :advent/2017/03)
--- a/src/2017/days/day-04.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-04.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/04 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/04) (in-package :advent/2017/04) (defun valid-hash-table-test-p (test)
--- a/src/2017/days/day-05.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-05.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/05 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/05) (in-package :advent/2017/05) (defun compute (data modification-function)
--- a/src/2017/days/day-06.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-06.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/06 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/06) (in-package :advent/2017/06)
--- a/src/2017/days/day-07.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-07.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/07 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/07) (in-package :advent/2017/07) (named-readtables:in-readtable :interpol-syntax)
--- a/src/2017/days/day-08.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-08.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/08 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/08) (in-package :advent/2017/08) (defun == (x y) (= x y))
--- a/src/2017/days/day-09.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-09.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/09 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/09) (in-package :advent/2017/09) (define-problem (2017 9) (stream) (15922 7314)
--- a/src/2017/days/day-10.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-10.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/10 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/10) (in-package :advent/2017/10) (define-problem (2017 10) (data alexandria:read-stream-content-into-string)
--- a/src/2017/days/day-11.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-11.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/11 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/11) (in-package :advent/2017/11) ;; https://www.redblobgames.com/grids/hexagons/#coordinates
--- a/src/2017/days/day-12.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-12.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/12 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/12) (in-package :advent/2017/12) (defun parse-line (line)
--- a/src/2017/days/day-13.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-13.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/13 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/13) (in-package :advent/2017/13) ;; There's a magical insight that you need to get if you want to do this
--- a/src/2017/days/day-14.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-14.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/14 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/14) (in-package :advent/2017/14) (defun print-grid (grid)
--- a/src/2017/days/day-15.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-15.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/15 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/15) (in-package :advent/2017/15) (defun-inline gen (previous factor)
--- a/src/2017/days/day-16.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-16.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/16 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/16) (in-package :advent/2017/16) (defparameter *initial* "abcdefghijklmnop")
--- a/src/2017/days/day-17.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-17.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/17 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/17) (in-package :advent/2017/17) (defun-inline spin (ring shift n) @@ -8,9 +8,9 @@ ring) (defun simple-part-2 (shift) - (-<> (ring 0) - (spin <> shift 50000000) - (ring-find <> 0) + (_ (ring 0) + (spin _ shift 50000000) + (ring-find _ 0) ring-next ring-data)) @@ -33,8 +33,8 @@ (define-problem (2017 17) (data read) (1244 11162912) (values - (-<> (ring 0) - (spin <> data 2017) + (_ (ring 0) + (spin _ data 2017) ring-next ring-data) (fast-part-2 data)))
--- a/src/2017/days/day-18.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/days/day-18.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2017/18 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2017/18) (in-package :advent/2017/18) (defclass* machine () @@ -22,7 +22,7 @@ (number register-or-constant))) (defmacro opcase (op &body clauses) - (alexandria:once-only (op) + (once-only (op) `(case (first ,op) ,@(iterate (for ((opcode . args) . body) :in clauses)
--- a/src/2017/knot-hash.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/knot-hash.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,5 +1,4 @@ -(defpackage :advent/knot-hash - #.cl-user::*advent-use* +(advent:defpackage* :advent/knot-hash (:export :simple-knot-hash :full-knot-hash)) (in-package :advent/knot-hash)
--- a/src/2017/number-spiral.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2017/number-spiral.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,5 +1,5 @@ (defpackage :advent/spiral - (:use :cl :losh :iterate :advent.quickutils) + (:use :cl :losh :iterate) (:export :number-coordinates)) (in-package :advent/spiral)
--- a/src/2018/days/day-01.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-01.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/01 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/01) (in-package :advent/2018/01)
--- a/src/2018/days/day-02.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-02.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,11 +1,11 @@ -(defpackage :advent/2018/02 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/02) (in-package :advent/2018/02) (define-problem (2018 2) (data read-lines) (8296 "pazvmqbftrbeosiecxlghkwud") (values (let* ((freqs (mapcar #'frequencies data)) - (counts (mapcar #'hash-table-values freqs))) + (counts (mapcar #'alexandria:hash-table-values freqs))) (* (count 2 counts :test #'member) (count 3 counts :test #'member))) ;; just brute force it
--- a/src/2018/days/day-03.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-03.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/03 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/03) (in-package :advent/2018/03) (named-readtables:in-readtable :interpol-syntax)
--- a/src/2018/days/day-04.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-04.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/04 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/04) (in-package :advent/2018/04) (named-readtables:in-readtable :interpol-syntax) @@ -34,17 +34,17 @@ (iterate (with result = (make-hash-table)) (for (guard start end) :in intervals) - (for histogram = (ensure-gethash guard result - (make-array 60 :initial-element 0))) + (for histogram = (alexandria: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) (143415 49944) - (let ((guard-histograms (-<> data - (sort <> #'string<) - (mapcar #'parse-line <>) + (let ((guard-histograms (_ data + (sort _ #'string<) + (mapcar #'parse-line _) sleep-intervals guard-histograms))) (nest
--- a/src/2018/days/day-05.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-05.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/05 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/05) (in-package :advent/2018/05) (named-readtables:in-readtable :interpol-syntax) @@ -14,7 +14,7 @@ (define-problem (2018 5) (data alexandria:read-stream-content-into-string) (10708 5330) - (deletef data #\newline) + (setf data (delete #\newline data)) (values (length (react data)) (iterate
--- a/src/2018/days/day-06.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-06.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/06 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/06) (in-package :advent/2018/06) (named-readtables:in-readtable :interpol-syntax) @@ -16,10 +16,10 @@ (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 #'>)) + (left (alexandria:extremum xs #'<)) + (bottom (alexandria:extremum ys #'<)) + (right (alexandria:extremum xs #'>)) + (top (alexandria:extremum ys #'>)) (counts (make-hash-table)) (infinite (make-hash-set))) (iterate
--- a/src/2018/days/day-07.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-07.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/07 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/07) (in-package :advent/2018/07) (named-readtables:in-readtable :interpol-syntax) @@ -10,7 +10,9 @@ (list target requirement))) (defun make-graph (edges) - (let* ((vertices (remove-duplicates (flatten-once edges))) + (let* ((vertices (remove-duplicates (loop :for edge :in edges + :if (listp edge) :append edge + :else :collect edge))) (graph (digraph:make-digraph :initial-vertices vertices))) (dolist (edge edges) (digraph:insert-edge graph (first edge) (second edge))) @@ -38,7 +40,7 @@ (recursively ((result nil)) (if (emptyp graph) (coerce (nreverse result) 'string) - (let ((next (extremum (digraph:leafs graph) 'char<))) + (let ((next (alexandria:extremum (digraph:leafs graph) 'char<))) (digraph:remove-vertex graph next) (recur (cons next result)))))) (iterate @@ -49,10 +51,10 @@ (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 + (for available-tasks = (_ graph digraph:leafs - (set-difference <> current-tasks) - (sort <> 'char<))) + (set-difference _ current-tasks) + (sort _ 'char<))) (do-array (worker workers) (when (null worker) (when-let ((task (pop available-tasks)))
--- a/src/2018/days/day-08.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-08.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/08 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/08) (in-package :advent/2018/08) (named-readtables:in-readtable :interpol-syntax)
--- a/src/2018/days/day-09.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-09.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/09 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/09) (in-package :advent/2018/09) (named-readtables:in-readtable :interpol-syntax) @@ -23,7 +23,7 @@ (ring-cutf circle)) (progn (ring-movef circle 1) (ring-insertf-after circle marble)))) - (extremum elves '>))) + (alexandria:extremum elves '>))) (define-problem (2018 9) (data alexandria:read-stream-content-into-string)
--- a/src/2018/days/day-10.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-10.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/10 #.cl-user::*advent-use* +(advent:defpackage* :advent/2018/10 (:shadow :x :y :bounds)) (in-package :advent/2018/10)
--- a/src/2018/days/day-11.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-11.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/11 #.cl-user::*advent-use* +(advent:defpackage* :advent/2018/11 (:shadow :x :y)) (in-package :advent/2018/11) @@ -15,12 +15,12 @@ (+ (x cell) 10)) (defun power-level (serial-number cell) - (-<> (rack-id cell) - (* <> (y cell)) - (+ <> serial-number) - (* <> (rack-id cell)) - (nth-digit 2 <>) - (- <> 5))) + (_ (rack-id cell) + (* _ (y cell)) + (+ _ serial-number) + (* _ (rack-id cell)) + (nth-digit 2 _) + (- _ 5))) (define-problem (2018 11) (serial-number read) ("245,14" "235,206,13") (let ((totals (make-array (list 300 300)))) @@ -52,7 +52,8 @@ (y :from 1 :to (- 301 n)))) (for power = (square-power x y n)) (finding (list x y power) :maximizing power)))) - (values (str:join "," (subseq (largest-square 3) 0 2)) + (values (str:join "," (mapcar #'aesthetic-string + (subseq (largest-square 3) 0 2))) (iterate (for n :from 1 :to 300) (for (x y power) = (largest-square n)) (finding (format nil "~D,~D,~D" x y n)
--- a/src/2018/days/day-12.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-12.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/12 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/12) (in-package :advent/2018/12) (named-readtables:in-readtable :interpol-syntax) @@ -58,10 +58,10 @@ (ppcre:register-groups-bind (state) (#?r"initial state: (\S+)" line) - (-<> state + (_ state runes-to-bits - (positions-if #'plusp <>) - (make-hash-set :initial-contents <>)))) + (positions-if #'plusp _) + (make-hash-set :initial-contents _)))) (defun parse-rule (line) (ppcre:register-groups-bind
--- a/src/2018/days/day-13.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-13.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/13 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/13) (in-package :advent/2018/13) ;;;; Cart --------------------------------------------------------------------- @@ -124,8 +124,8 @@ (t cart-or-track-rune))) (defun parse-track (lines) - (removef lines "" :test #'string=) - (let ((track (make-array (list (extremum (mapcar #'length lines) '>) + (alexandria:removef lines "" :test #'string=) + (let ((track (make-array (list (alexandria:extremum (mapcar #'length lines) '>) (length lines)) :element-type 'character :initial-element #\space)) @@ -169,7 +169,7 @@ (and (= y1 y2) (< x1 x2))))) ; or further left (defun tick-carts (track carts) - (dolist (cart (sort (hash-table-values carts) #'cart<)) + (dolist (cart (sort (alexandria:hash-table-values carts) #'cart<)) (tick-cart track carts cart))) @@ -199,7 +199,7 @@ (for tick :from 1) (for carts-remaining = (hash-table-count carts)) (finding - (-<> carts hash-table-values first cart-position format-position) + (_ carts alexandria:hash-table-values first cart-position format-position) :such-that (= 1 carts-remaining)))))) (define-problem (2018 13) (data read-lines) ("83,49" "73,36")
--- a/src/2018/days/day-14.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-14.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/14 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/14) (in-package :advent/2018/14) (defun combine (recipes elves) @@ -10,7 +10,7 @@ (length recipes))))) (defun format-output (scores) - (str:join "" (coerce scores 'list))) + (str:join "" (map 'list #'aesthetic-string scores))) (define-problem (2018 14) (data read) ("3610281143" 20211326) #+sbcl (sb-ext:gc :full t)
--- a/src/2018/days/day-15.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2018/days/day-15.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2018/15 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2018/15) (in-package :advent/2018/15) ;;;; Points ------------------------------------------------------------------- @@ -137,21 +137,21 @@ (neighbors p))) (defun adjacent-enemies (mob) - (-<> mob + (_ mob loc/p neighbors - (mapcar #'loc <>) - (remove nil <>) - (remove-if-not (curry #'enemiesp mob) <>))) + (mapcar #'loc _) + (remove nil _) + (remove-if-not (curry #'enemiesp mob) _))) (defun adjacent-enemy (mob) (first (sort (adjacent-enemies mob) #'loc<))) (defun target-squares (unit) - (-<> unit + (_ unit targets - (mapcan (compose #'open-neighbors #'loc/p) <>) - (remove-duplicates <> :test #'=))) + (mapcan (compose #'open-neighbors #'loc/p) _) + (remove-duplicates _ :test #'=))) (defun step-cost (start from to) @@ -217,7 +217,7 @@ ;;;; World Generation --------------------------------------------------------- (defun generate-world (lines) - (removef lines "" :test #'string=) + (alexandria:removef lines "" :test #'string=) (beast:clear-entities) (let* ((rows (length lines)) (cols (length (first lines))))
--- a/src/2019/days/day-01.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-01.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/01 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/01) (in-package :advent/2019/01) @@ -15,3 +15,7 @@ (values (summation data :key #'fuel-required) (summation data :key #'complete-fuel-required))) +;# Scratch -------------------------------------------------------------------- + +;; (run) +;; (1am:run)
--- a/src/2019/days/day-02.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-02.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/02 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/02) (in-package :advent/2019/02) (define-problem (2019 2) (data read-numbers) (3790689 6533)
--- a/src/2019/days/day-03.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-03.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/03 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/03) (in-package :advent/2019/03) (defun parse-path (string)
--- a/src/2019/days/day-04.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-04.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/04 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/04) (in-package :advent/2019/04) (defun nondecreasing-digits-p (n)
--- a/src/2019/days/day-05.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-05.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/05 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/05) (in-package :advent/2019/05) (define-problem (2019 5) (data read-numbers) (14522484 4655956)
--- a/src/2019/days/day-06.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-06.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/06 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/06) (in-package :advent/2019/06) (define-problem (2019 6) (data read-lines) (301100 547)
--- a/src/2019/days/day-07.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-07.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/07 #.cl-user::*advent-use* +(advent:defpackage* :advent/2019/07 (:shadow :queue)) (in-package :advent/2019/07) @@ -26,12 +26,12 @@ (defun run-amplifiers (program phases) (multiple-value-bind (amplifiers queue) (make-amplifiers program phases) - (-<> amplifiers + (_ amplifiers (mapcar (lambda (amp) (bt:make-thread (curry #'advent/intcode:run-machine amp) :name "Amplifier Thread")) - <>) - (map nil #'bt:join-thread <>)) + _) + (map nil #'bt:join-thread _)) (jpl-queues:dequeue queue))) (defun maximum-permutation (function sequence) @@ -60,8 +60,8 @@ -1 56 1005 56 6 99 0 0 0 0 10)) (defun kill-amplifiers () - (-<> (bt:all-threads) - (remove "Amplifier Thread" <> :test-not #'string= :key #'bt:thread-name) - (map nil #'bt:destroy-thread <>))) + (_ (bt:all-threads) + (remove "Amplifier Thread" _ :test-not #'string= :key #'bt:thread-name) + (map nil #'bt:destroy-thread _))) (kill-amplifiers)
--- a/src/2019/days/day-08.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-08.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/08 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/08) (in-package :advent/2019/08) (defun read-layer (stream width height)
--- a/src/2019/days/day-09.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-09.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/09 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/09) (in-package :advent/2019/09) (define-problem (2019 9) (data read-numbers) (2955820355 46643)
--- a/src/2019/days/day-10.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-10.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,6 +1,33 @@ -(defpackage :advent/2019/10 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/10) (in-package :advent/2019/10) + + +(defun equivalence-classes (equiv seq) ; From quickutil TODO replace this + "Partition the sequence `seq` into a list of equivalence classes +defined by the equivalence relation `equiv`." + (let ((classes nil)) + (labels ((find-equivalence-class (x) + (member-if (lambda (class) + (funcall equiv x (car class))) + classes)) + + (add-to-class (x) + (let ((class (find-equivalence-class x))) + (if class + (push x (car class)) + (push (list x) classes))))) + (declare (dynamic-extent (function find-equivalence-class) + (function add-to-class)) + (inline find-equivalence-class + add-to-class)) + + ;; Partition into equivalence classes. + (map nil #'add-to-class seq) + + ;; Return the classes. + classes))) + (defun asteroid-positions (map) "Return a list of the asteroid positions in the 2D input `map`." (destructuring-bind (rows cols) (array-dimensions map)
--- a/src/2019/days/day-11.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-11.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/11 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/11) (in-package :advent/2019/11) (defun run-robot (program &key (origin 'black))
--- a/src/2019/days/day-13.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-13.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -73,9 +73,9 @@ (defvar *data* nil) -(define-problem (2019 13) (data read-numbers) (255) +(define-problem (2019 13) (data read-numbers) (255 12338) (setf *data* data) - (values (count 'block (hash-table-values (run-game data))) + (values (count 'block (alexandria:hash-table-values (run-game data))) (play-automatically data)))
--- a/src/2019/days/day-14.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-14.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,8 +1,12 @@ (advent:defpackage* :advent/2019/14) (in-package :advent/2019/14) +(defun chem-symbol (name) + (let ((*package* (find-package :advent/2019/14))) + (symb name))) + (defun parse-chem (chemicals) - (iterate (for ((#'parse-integer amount) (#'symb name)) + (iterate (for ((#'parse-integer amount) (#'chem-symbol name)) :matching "(\\d+) (\\w+)" :against chemicals) (collect (cons name amount))))
--- a/src/2019/days/day-15.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/days/day-15.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -33,11 +33,11 @@ (defun print-world (machine) (print-hash-table-map (world machine) + :default #\space :pad 1 - :get (lambda (pos) - (if (= (pos machine) pos) - #\@ - (gethash pos (world machine) #\space))))) + :extra (lambda (pos) + (when (= (pos machine) pos) + #\@)))) (defun dir->int (dir) (ecase dir
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/2019/days/day-16.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -0,0 +1,84 @@ +(advent:defpackage* :advent/2019/16) +(in-package :advent/2019/16) + +(defparameter *pattern* #(0 1 0 -1)) + +(defun compute-element (input i) + (iterate + (for x :in-vector input) + (generate p :around *pattern*) + (if-first-time (next p)) ; initialize pattern + (for c :modulo (1+ i) :from 1) ; skip first element in the expanded pattern + (when (zerop c) + (next p)) + (summing (* x p) :into result) + (returning (mod (abs result) 10)))) + +(defun run-phase (input output) + (iterate + (for i :below (length output)) + (setf (aref output i) (compute-element input i)))) + +(defun fft (input &optional (n 1)) + (let ((input (fresh-vector input)) + (output (fresh-vector input))) + (do-repeat n + (run-phase input output) + (rotatef input output)) + input)) + +(defun part2 (digits) + ;; This is a dumb hack. + ;; + ;; Because the message is in the latter half of the result, we can cheat and + ;; take advantage of the fact that for any element in the last half of the + ;; input, the result is always just the sum of the tail of the array starting + ;; at that element. + ;; + ;; This is because by the time we're in the back half of the array, the (0 + ;; 1 0 -1) input pattern repeats the 0 i times (which wipes out everything + ;; before i) and the 1 i+1 times (which means we just sum up the rest of the + ;; array): + ;; + ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 + ;; input a b c d e f g h i j k l m len = 13 + ;; pattern for i = 0 1 0 -1 0 1 0 -1 0 1 0 -1 0 1 + ;; pattern for i = 1 0 1 1 0 0 -1 -1 0 0 1 1 0 0 + ;; pattern for i = 2 0 0 1 1 1 0 0 0 -1 -1 -1 0 0 + ;; pattern for i = 3 0 0 0 1 1 1 1 0 0 0 0 -1 -1 + ;; pattern for i = 4 0 0 0 0 1 1 1 1 1 0 0 0 0 + ;; pattern for i = 5 0 0 0 0 0 1 1 1 1 1 1 0 0 + ;; pattern for i = 6 0 0 0 0 0 0 1 1 1 1 1 1 1 + ;; <---- all zeroes all ones ---------> + ;; + ;; Additionally: by starting at the end of the array we don't need a temporary + ;; array, we can just keep a running sum and not worrying about destroying the + ;; input. + ;; + ;; This is cheating, but whatever, I didn't really like this problem much + ;; anyway. + (let* ((digits (coerce (iterate (repeat 10000) + (appending digits)) + 'vector)) + (offset (digits-to-number (subseq digits 0 7))) + (data (subseq digits offset))) + (do-repeat 100 + (iterate + (for x :in-vector data :with-index i :from (1- (length data)) :downto 0) + (summing x :into n) + (setf (aref data i) (mod n 10)))) + (subseq data 0 8))) + +(defun digits-string (digits) + (map 'string #'digit-char digits)) + +(define-problem (2019 16) (data read-digits) ("96136976" "85600369") + (values (_ (fft data 100) + (subseq _ 0 8) + digits-string) + (digits-string (part2 data)))) + +#; Scratch -------------------------------------------------------------------- + +(part2 + '(0 3 0 3 6 7 3 2 5 7 7 2 1 2 9 4 4 0 6 3 4 9 1 5 6 5 4 7 4 6 6 4 ))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/2019/days/day-17.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -0,0 +1,74 @@ +(advent:defpackage* :advent/2019/17) +(in-package :advent/2019/17) + +(defclass* world () + ((tiles :initform (make-hash-table)) + robot-pos + robot-dir)) + +(defun record-string (program) + (gathering-vector (:element-type 'character) + (advent/intcode:run program :output (compose #'gather #'code-char)))) + +(defun parse-char (char) + (case char + (#\^ (values #\# #c( 0 -1))) + (#\v (values #\# #c( 0 1))) + (#\< (values #\# #c(-1 0))) + (#\> (values #\# #c( 1 0))) + (t (values char nil)))) + +(defun robot-char (dir) + (ecase dir + (#c( 0 -1) #\^) + (#c( 0 1) #\v) + (#c(-1 0) #\<) + (#c( 1 0) #\>))) + +(defun parse-map (string) + (iterate + (with world = (make-instance 'world)) + (for line :in (split-sequence:split-sequence #\newline string + :remove-empty-subseqs t)) + (for row :from 0) + (iterate + (for char :in-string line :with-index col) + (for pos = (complex row col)) + (for (values tile dir) = (parse-char char)) + (setf (gethash pos (tiles world)) tile) + (when dir + (setf (robot-pos world) pos + (robot-dir world) dir))) + (returning world))) + +(defun intersectionp (world pos) + (every (lambda (x) + (eql #\# (gethash x (tiles world)))) + (manhattan-neighborhood pos))) + +(defun intersections (world) + (remove-if-not (curry #'intersectionp world) + (alexandria:hash-table-keys (tiles world)))) + +(defun alignment-parameter (pos) + (* (realpart pos) + (imagpart pos))) + +(defun draw-world (world) + (print-hash-table-map (tiles world) + :swap-axes t + :flip-y t + :extra (lambda (pos) + (cond ((= pos (robot-pos world)) + (robot-char (robot-dir world))) + ((intersectionp world pos) #\O))))) + +(define-problem (2019 17) (data read-numbers) (7328) + (advent/intcode::disassemble-program (advent/intcode:init data)) + (let ((world (parse-map (record-string data)))) + (draw-world world) + (summation (intersections world) :key #'alignment-parameter))) + +#; Scratch -------------------------------------------------------------------- + +
--- a/src/2019/intcode.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/2019/intcode.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -1,5 +1,4 @@ -(defpackage :advent/intcode - #.cl-user::*advent-use* +(advent:defpackage* :advent/intcode (:shadow :step :trace) (:export :init :step :run :run-machine :*trace*)) @@ -175,9 +174,9 @@ (return) (decf limit))) (with address = start) - (with addresses = (-<> (memory machine) + (with addresses = (_ (memory machine) alexandria:hash-table-keys - (sort <> #'<))) + (sort _ #'<))) (with bound = (1+ (elt addresses (1- (length addresses))))) (flet ((advance (addr) (iterate
--- a/src/utils.lisp Sun Dec 15 13:14:04 2019 -0500 +++ b/src/utils.lisp Mon Nov 29 23:19:14 2021 -0500 @@ -32,9 +32,6 @@ (symbol (alexandria:make-keyword input)) (string (alexandria:make-keyword (string-upcase (str:trim input))))))) -(defun ensure-list (input) - (if (listp input) input (list input))) - ;;;; Problems ----------------------------------------------------------------- (defmacro define-problem-tests ((year day) part1 part2) @@ -48,7 +45,7 @@ (defmacro define-problem ((year day) (arg &optional (reader 'identity)) - (&optional answer1 answer2) + (&optional part-1-answer part-2-answer) &body body) (multiple-value-bind (body declarations docstring) (alexandria:parse-body body :documentation t) @@ -64,8 +61,8 @@ (setf ,arg (,reader (ensure-stream (or ,arg ,file))))) ,@body) (when ,file (close ,file))))) - ,@(when answer1 - (list `(define-problem-tests (,year ,day) ,answer1 ,answer2))) + ,@(when part-1-answer + (list `(define-problem-tests (,year ,day) ,part-1-answer ,part-2-answer))) 'run))))) (defun problem-data-path (year day) @@ -77,7 +74,7 @@ (defmacro defpackage* (name &body body) `(defpackage ,name - (:use :cl :losh :iterate :advent :advent.quickutils) + (:use :cl :losh :iterate :advent) ,@body)) @@ -140,6 +137,7 @@ (defun read-all (stream) "Read all forms from `stream` and return them as a fresh list." (read-and-collect stream #'read)) + (defun read-numbers (stream) (read-numbers-from-string (alexandria:read-stream-content-into-string stream))) @@ -179,6 +177,12 @@ (setf (aref result row col) char)) (returning result))) +(defun read-digits (stream) + (iterate (for char :in-stream stream :using #'read-char) + (for digit = (digit-char-p char)) + (when digit + (collect digit)))) + ;;;; Rings -------------------------------------------------------------------- (declaim (inline ring-prev ring-next ring-data)) @@ -415,6 +419,14 @@ (+ point #c(0 -1)) (+ point #c(-1 0)))) +(defun manhattan-neighborhood (point) + "Return point and points adjacent to point (excluding diagonals) on the complex plane." + (list point + (+ point #c(0 1)) + (+ point #c(1 0)) + (+ point #c(0 -1)) + (+ point #c(-1 0)))) + (defgeneric emptyp (collection) (:documentation "Return whether `collection` is empty.")) @@ -524,6 +536,22 @@ (nreverse result)) result-type))) +(defun digits-to-number (digits &key from-end (radix 10)) + "Concatenate `digits` to return an integer in base `radix`. + + If `from-end` is `t`, start at the end of the list. + + " + (if digits + (if from-end + (iterate (for d :in digits) + (for multiplier :first 1 :then (* radix multiplier)) + (summing (* multiplier d))) + (reduce (lambda (total digit) + (+ (* total radix) digit)) + digits)) + 0)) + (defun fresh-vector (sequence) (if (typep sequence 'vector) @@ -756,8 +784,10 @@ (defun print-hash-table-map (table &key + flip-x flip-y - get + swap-axes + extra (pad 0) (default #\space) (key #'identity)) @@ -781,12 +811,16 @@ (incf right pad) (incf bottom (- pad)) (incf top pad) - (do-irange ((y (if flip-y bottom top) - (if flip-y top bottom))) + (when flip-x (rotatef left right)) + (when flip-y (rotatef bottom top)) + (do-irange ((y top bottom)) (do-irange ((x left right)) - (princ (funcall key (if get - (funcall get (complex x y)) - (gethash (complex x y) table default))))) + (let ((pos (if swap-axes + (complex y x) + (complex x y)))) + (princ (funcall key (or (when extra + (funcall extra pos)) + (gethash pos table default)))))) (terpri)))) (defun esc (string)
--- a/vendor/make-quickutils.lisp Sun Dec 15 13:14:04 2019 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -(ql:quickload 'quickutil) - -(qtlc:save-utils-as - "quickutils.lisp" - :utilities '( - - :compose - :copy-hash-table - :curry - :deletef - :ensure-gethash - :equivalence-classes - :extremum - :flatten-once - :hash-table-keys - :hash-table-values - :once-only - :rcurry - :read-file-into-string - :removef - :symb - :tree-collect - :with-gensyms - - ) - :package "ADVENT.QUICKUTILS")
--- a/vendor/quickutils-package.lisp Sun Dec 15 13:14:04 2019 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package "ADVENT.QUICKUTILS") - (defpackage "ADVENT.QUICKUTILS" - (:documentation "Package that contains Quickutil utility functions.") - (:use :cl)))) - -(in-package "ADVENT.QUICKUTILS") - -;; need to define this here so sbcl will shut the hell up about it being -;; undefined when compiling quickutils.lisp. computers are trash. -(defparameter *utilities* nil) -
--- a/vendor/quickutils.lisp Sun Dec 15 13:14:04 2019 -0500 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,449 +0,0 @@ -;;;; This file was automatically generated by Quickutil. -;;;; See http://quickutil.org for details. - -;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :DELETEF :ENSURE-GETHASH :EQUIVALENCE-CLASSES :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SYMB :TREE-COLLECT :WITH-GENSYMS) :ensure-package T :package "ADVENT.QUICKUTILS") - -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package "ADVENT.QUICKUTILS") - (defpackage "ADVENT.QUICKUTILS" - (:documentation "Package that contains Quickutil utility functions.") - (:use #:cl)))) - -(in-package "ADVENT.QUICKUTILS") - -(when (boundp '*utilities*) - (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE - :COPY-HASH-TABLE :CURRY :DELETEF :ENSURE-GETHASH - :EQUIVALENCE-CLASSES :EXTREMUM :FLATTEN-ONCE :MAPHASH-KEYS - :HASH-TABLE-KEYS :MAPHASH-VALUES :HASH-TABLE-VALUES - :ONCE-ONLY :RCURRY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE - :READ-FILE-INTO-STRING :REMOVEF :MKSTR :SYMB :TREE-COLLECT - :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`, -using the second (optional, defaulting to `\"G\"`) argument." - (let ((g (if (typep x '(integer 0)) x (string x)))) - (loop repeat length - collect (gensym g)))) - ) ; eval-when -(eval-when (:compile-toplevel :load-toplevel :execute) - ;;; To propagate return type and allow the compiler to eliminate the IF when - ;;; it is known if the argument is function or not. - (declaim (inline ensure-function)) - - (declaim (ftype (function (t) (values function &optional)) - ensure-function)) - (defun ensure-function (function-designator) - "Returns the function designated by `function-designator`: -if `function-designator` is a function, it is returned, otherwise -it must be a function name and its `fdefinition` is returned." - (if (functionp function-designator) - function-designator - (fdefinition function-designator))) - ) ; eval-when - - (defun compose (function &rest more-functions) - "Returns a function composed of `function` and `more-functions` that applies its ; -arguments to to each in turn, starting from the rightmost of `more-functions`, -and then calling the next one with the primary value of the last." - (declare (optimize (speed 3) (safety 1) (debug 1))) - (reduce (lambda (f g) - (let ((f (ensure-function f)) - (g (ensure-function g))) - (lambda (&rest arguments) - (declare (dynamic-extent arguments)) - (funcall f (apply g arguments))))) - more-functions - :initial-value function)) - - (define-compiler-macro compose (function &rest more-functions) - (labels ((compose-1 (funs) - (if (cdr funs) - `(funcall ,(car funs) ,(compose-1 (cdr funs))) - `(apply ,(car funs) arguments)))) - (let* ((args (cons function more-functions)) - (funs (make-gensym-list (length args) "COMPOSE"))) - `(let ,(loop for f in funs for arg in args - collect `(,f (ensure-function ,arg))) - (declare (optimize (speed 3) (safety 1) (debug 1))) - (lambda (&rest arguments) - (declare (dynamic-extent arguments)) - ,(compose-1 funs)))))) - - - (defun copy-hash-table (table &key key test size - rehash-size rehash-threshold) - "Returns a copy of hash table `table`, with the same keys and values -as the `table`. The copy has the same properties as the original, unless -overridden by the keyword arguments. - -Before each of the original values is set into the new hash-table, `key` -is invoked on the value. As `key` defaults to `cl:identity`, a shallow -copy is returned by default." - (setf key (or key 'identity)) - (setf test (or test (hash-table-test table))) - (setf size (or size (hash-table-size table))) - (setf rehash-size (or rehash-size (hash-table-rehash-size table))) - (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table))) - (let ((copy (make-hash-table :test test :size size - :rehash-size rehash-size - :rehash-threshold rehash-threshold))) - (maphash (lambda (k v) - (setf (gethash k copy) (funcall key v))) - table) - copy)) - - - (defun curry (function &rest arguments) - "Returns a function that applies `arguments` and the arguments -it is called with to `function`." - (declare (optimize (speed 3) (safety 1) (debug 1))) - (let ((fn (ensure-function function))) - (lambda (&rest more) - (declare (dynamic-extent more)) - ;; Using M-V-C we don't need to append the arguments. - (multiple-value-call fn (values-list arguments) (values-list more))))) - - (define-compiler-macro curry (function &rest arguments) - (let ((curries (make-gensym-list (length arguments) "CURRY")) - (fun (gensym "FUN"))) - `(let ((,fun (ensure-function ,function)) - ,@(mapcar #'list curries arguments)) - (declare (optimize (speed 3) (safety 1) (debug 1))) - (lambda (&rest more) - (apply ,fun ,@curries more))))) - - - (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 -already in the table." - `(multiple-value-bind (value ok) (gethash ,key ,hash-table) - (if ok - (values value ok) - (values (setf (gethash ,key ,hash-table) ,default) nil)))) - - - (defun equivalence-classes (equiv seq) - "Partition the sequence `seq` into a list of equivalence classes -defined by the equivalence relation `equiv`." - (let ((classes nil)) - (labels ((find-equivalence-class (x) - (member-if (lambda (class) - (funcall equiv x (car class))) - classes)) - - (add-to-class (x) - (let ((class (find-equivalence-class x))) - (if class - (push x (car class)) - (push (list x) classes))))) - (declare (dynamic-extent (function find-equivalence-class) - (function add-to-class)) - (inline find-equivalence-class - add-to-class)) - - ;; Partition into equivalence classes. - (map nil #'add-to-class seq) - - ;; Return the classes. - classes))) - - - (defun extremum (sequence predicate &key key (start 0) end) - "Returns the element of `sequence` that would appear first if the subsequence -bounded by `start` and `end` was sorted using `predicate` and `key`. - -`extremum` determines the relationship between two elements of `sequence` by using -the `predicate` function. `predicate` should return true if and only if the first -argument is strictly less than the second one (in some appropriate sense). Two -arguments `x` and `y` are considered to be equal if `(funcall predicate x y)` -and `(funcall predicate y x)` are both false. - -The arguments to the `predicate` function are computed from elements of `sequence` -using the `key` function, if supplied. If `key` is not supplied or is `nil`, the -sequence element itself is used. - -If `sequence` is empty, `nil` is returned." - (let* ((pred-fun (ensure-function predicate)) - (key-fun (unless (or (not key) (eq key 'identity) (eq key #'identity)) - (ensure-function key))) - (real-end (or end (length sequence)))) - (cond ((> real-end start) - (if key-fun - (flet ((reduce-keys (a b) - (if (funcall pred-fun - (funcall key-fun a) - (funcall key-fun b)) - a - b))) - (declare (dynamic-extent #'reduce-keys)) - (reduce #'reduce-keys sequence :start start :end real-end)) - (flet ((reduce-elts (a b) - (if (funcall pred-fun a b) - a - b))) - (declare (dynamic-extent #'reduce-elts)) - (reduce #'reduce-elts sequence :start start :end real-end)))) - ((= real-end start) - nil) - (t - (error "Invalid bounding indexes for sequence of length ~S: ~S ~S, ~S ~S" - (length sequence) - :start start - :end end))))) - - - (defun flatten-once (list) - "Flatten `list` once." - (loop :for x :in list - :if (listp x) - :append x - :else - :collect x)) - - - (declaim (inline maphash-keys)) - (defun maphash-keys (function table) - "Like `maphash`, but calls `function` with each key in the hash table `table`." - (maphash (lambda (k v) - (declare (ignore v)) - (funcall function k)) - table)) - - - (defun hash-table-keys (table) - "Returns a list containing the keys of hash table `table`." - (let ((keys nil)) - (maphash-keys (lambda (k) - (push k keys)) - table) - keys)) - - - (declaim (inline maphash-values)) - (defun maphash-values (function table) - "Like `maphash`, but calls `function` with each value in the hash table `table`." - (maphash (lambda (k v) - (declare (ignore k)) - (funcall function v)) - table)) - - - (defun hash-table-values (table) - "Returns a list containing the values of hash table `table`." - (let ((values nil)) - (maphash-values (lambda (v) - (push v values)) - table) - values)) - - - (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. - -Each of `specs` must either be a symbol naming the variable to be rebound, or of -the form: - - (symbol initform) - -Bare symbols in `specs` are equivalent to - - (symbol symbol) - -Example: - - (defmacro cons1 (x) (once-only (x) `(cons ,x ,x))) - (let ((y 0)) (cons1 (incf y))) => (1 . 1)" - (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY")) - (names-and-forms (mapcar (lambda (spec) - (etypecase spec - (list - (destructuring-bind (name form) spec - (cons name form))) - (symbol - (cons spec spec)))) - specs))) - ;; bind in user-macro - `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n))))) - gensyms names-and-forms) - ;; bind in final expansion - `(let (,,@(mapcar (lambda (g n) - ``(,,g ,,(cdr n))) - gensyms names-and-forms)) - ;; bind in user-macro - ,(let ,(mapcar (lambda (n g) (list (car n) g)) - names-and-forms gensyms) - ,@forms))))) - - - (defun rcurry (function &rest arguments) - "Returns a function that applies the arguments it is called -with and `arguments` to `function`." - (declare (optimize (speed 3) (safety 1) (debug 1))) - (let ((fn (ensure-function function))) - (lambda (&rest more) - (declare (dynamic-extent more)) - (multiple-value-call fn (values-list more) (values-list arguments))))) - - - (defmacro with-open-file* ((stream filespec &key direction element-type - if-exists if-does-not-exist external-format) - &body body) - "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use -the default value specified for `open`." - (once-only (direction element-type if-exists if-does-not-exist external-format) - `(with-open-stream - (,stream (apply #'open ,filespec - (append - (when ,direction - (list :direction ,direction)) - (when ,element-type - (list :element-type ,element-type)) - (when ,if-exists - (list :if-exists ,if-exists)) - (when ,if-does-not-exist - (list :if-does-not-exist ,if-does-not-exist)) - (when ,external-format - (list :external-format ,external-format))))) - ,@body))) - - - (defmacro with-input-from-file ((stream-name file-name &rest args - &key (direction nil direction-p) - &allow-other-keys) - &body body) - "Evaluate `body` with `stream-name` to an input stream on the file -`file-name`. `args` is sent as is to the call to `open` except `external-format`, -which is only sent to `with-open-file` when it's not `nil`." - (declare (ignore direction)) - (when direction-p - (error "Can't specifiy :DIRECTION for WITH-INPUT-FROM-FILE.")) - `(with-open-file* (,stream-name ,file-name :direction :input ,@args) - ,@body)) - - - (defun read-file-into-string (pathname &key (buffer-size 4096) external-format) - "Return the contents of the file denoted by `pathname` as a fresh string. - -The `external-format` parameter will be passed directly to `with-open-file` -unless it's `nil`, which means the system default." - (with-input-from-file - (file-stream pathname :external-format external-format) - (let ((*print-pretty* nil)) - (with-output-to-string (datum) - (let ((buffer (make-array buffer-size :element-type 'character))) - (loop - :for bytes-read = (read-sequence buffer file-stream) - :do (write-sequence buffer datum :start 0 :end bytes-read) - :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. - -Extracted from _On Lisp_, chapter 4." - (with-output-to-string (s) - (dolist (a args) (princ a s)))) - - - (defun symb (&rest args) - "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol. - -Extracted from _On Lisp_, chapter 4. - -See also: `symbolicate`" - (values (intern (apply #'mkstr args)))) - - - (defun tree-collect (predicate tree) - "Returns a list of every node in the `tree` that satisfies the `predicate`. If there are any improper lists in the tree, the `predicate` is also applied to their dotted elements." - (let ((sentinel (gensym))) - (flet ((my-cdr (obj) - (cond ((consp obj) - (let ((result (cdr obj))) - (if (listp result) - result - (list result sentinel)))) - (t - (list sentinel))))) - (loop :for (item . rest) :on tree :by #'my-cdr - :until (eq item sentinel) - :if (funcall predicate item) collect item - :else - :if (listp item) - :append (tree-collect predicate item))))) - - - (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 deletef ensure-gethash equivalence-classes extremum - flatten-once hash-table-keys hash-table-values once-only rcurry read-file-into-string - removef symb tree-collect with-gensyms with-unique-names))) - -;;;; END OF quickutils.lisp ;;;;