Refactor 2023/11

- Get rid of some previously required LOOPING defaulting logic
  (or (looping ...) 0)
- Create SUM-ALL-DISTANCES to calculate solutions
- Replace LOOP with DOLISTL

.lispwords

@@ -10,6 +10,7 @@
 (destructuring-bind 2)
 (dolist 1)
 (dolist+ 1)
+(dolistl 1)
 (dorange 1)
 (dorange 1)
 (dorangei 1)

src/2023/day11.lisp

@@ -2,29 +2,44 @@
 (in-package :aoc/2023/11)
 
 
-(defun parse-image (&optional (strings (uiop:read-file-lines #P"src/2023/day11.txt")))
+(defun parse-image (&optional (expansion-size 2)
+                              (strings (uiop:read-file-lines #P"src/2023/day11.txt")))
   (bnd* ((rows (length strings))
          (cols (length (first strings)))
          (image (make-hash-table :test 'equal))
-         (ix (make-array rows :initial-element 0))
-         (jx (make-array cols :initial-element 0)))
+         (di (make-array rows :initial-element 0))
+         (dj (make-array cols :initial-element 0)))
     (flet ((row (i) (nth i strings))
            (col (j) (looping (dorange (i 0 rows) (collect! (char (nth i strings) j))))))
+      ; for each row, count all the rows expansions up until that row
       (dorange (i 0 rows)
-        (setf (aref ix i) (or (looping
-                                (dorange (ii 0 i)
-                                  (count! (every [char= _ #\.] (row ii)))))
-                              0)))
+        (setf (aref di i) (looping
+                            (dorange (ii 0 i)
+                              (count! (every [char= _ #\.] (row ii)))))))
+      ; for each col, count all the cols expansions up until that col
       (dorange (j 0 cols)
-        (setf (aref jx j) (or (looping
-                                (dorange (jj 0 j)
-                                  (count! (every [char= _ #\.] (col jj)))))
-                              0)))
+        (setf (aref dj j) (looping
+                            (dorange (jj 0 j)
+                              (count! (every [char= _ #\.] (col jj)))))))
+      ; parse galaxies, keeping track of expansions
       (dolist+ ((i s) (enumerate strings))
         (dolist+ ((j ch) (enumerate s))
           (when (char= ch #\# )
-            (setf (gethash (list (+ i (* (aref ix i) (1- 1000000))) (+ j (* (aref jx j) (1- 1000000)))) image) ch))))
+            (bnd* ((ii (+ i (* (aref di i) (1- expansion-size))))
+                   (jj (+ j (* (aref dj j) (1- expansion-size)))))
+              (setf (gethash (list ii jj) image) ch)))))
       image)))
 
-#+#:excluded (loop for (g1 . rest) on (hash-table-keys (parse-image)) sum
-                   (loop for g2 in rest sum (manhattan-distance g1 g2)))
+
+(defun sum-all-distances (&optional (image (parse-image)))
+  (looping
+    (dolistl ((g1 . rest) (hash-table-keys image))
+      (dolist (g2 rest)
+        (sum! (manhattan-distance g1 g2))))))
+
+
+(define-solution (2023 11) (strings)
+  (values (sum-all-distances (parse-image 2 strings))
+          (sum-all-distances (parse-image 1000000 strings))))
+
+(define-test (2023 11) (9550717 648458253817))

vendor/make-quickutils.lisp

@@ -16,16 +16,17 @@
                :keep-if
                :keep-if-not
 
+               :aand
                :aif
                :awhen
-               :aand
                :bnd*
                :bnd1
                :copy-array
                :copy-hash-table
                :digits
                :divf
                :dolist+
+               :dolistl
                :dorange
                :dorangei
                :doseq
@@ -43,8 +44,8 @@
                :mulf
                :ncycle
                :repeat
-               :string-starts-with-p
                :string-ends-with-p
+               :string-starts-with-p
                :symb
                :void
                :when-let

vendor/quickutils.lisp

@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:KEEP-IF :KEEP-IF-NOT :AAND :AIF :AWHEN :BND* :BND1 :CHUNKED :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOLIST+ :DORANGE :DORANGEI :DOSEQ :ENUMERATE :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :REPEAT :STRING-ENDS-WITH-P :STRING-STARTS-WITH-P :SYMB :VOID :WHEN-LET :WHILE :WITH-GENSYMS) :ensure-package T :package "AOC.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:KEEP-IF :KEEP-IF-NOT :AAND :AIF :AWHEN :BND* :BND1 :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOLIST+ :DOLISTL :DORANGE :DORANGEI :DOSEQ :ENUMERATE :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :REPEAT :STRING-ENDS-WITH-P :STRING-STARTS-WITH-P :SYMB :VOID :WHEN-LET :WHILE :WITH-GENSYMS) :ensure-package T :package "AOC.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AOC.QUICKUTILS")
@@ -14,9 +14,9 @@
 
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:ABBR :KEEP-IF :KEEP-IF-NOT :LET1 :AIF
-                                         :AAND :AWHEN :BND* :BND1 :CHUNKED
-                                         :COPY-ARRAY :COPY-HASH-TABLE :DIGITS
-                                         :DIVF :DOLIST+ :DORANGE :DORANGEI
+                                         :AAND :AWHEN :BND* :BND1 :COPY-ARRAY
+                                         :COPY-HASH-TABLE :DIGITS :DIVF
+                                         :DOLIST+ :DOLISTL :DORANGE :DORANGEI
                                          :DOSEQ :ENUMERATE :FLATTEN
                                          :HASH-TABLE-ALIST
                                          :HASH-TABLE-KEY-EXISTS-P :MAPHASH-KEYS
@@ -162,19 +162,6 @@ BND* will expand to a DESTRUCTURING-BIND call:
        ,@body))
 
 
-  (defun chunked (seq size)
-    "Split `seq` into chunks of length `size`.
-
-Note: the last chunk is guaranteed to have length of `size` only if
-the length of `seq` is a multiple of `size`."
-    (let* ((total (length seq))
-           (amount (ceiling total size))
-           (res nil))
-      (dotimes (i amount (reverse res))
-        (push (subseq seq (* i size) (min (* (1+ i) size) total))
-              res))))
-
-
   (defun copy-array (array &key (element-type (array-element-type array))
                                 (fill-pointer (and (array-has-fill-pointer-p array)
                                                    (fill-pointer array)))
@@ -252,6 +239,15 @@ the following identity holds:
     `(loop :for ,var :in ,list do ,@body ,@(when result? `(:finally (return ,result)))))
 
 
+  (defmacro dolistl ((var list &optional (result nil result?)) &body body)
+    "Like DOLIST, except:
+
+- `var` is bound to successive sublists of `list` (similar to MAPL)
+- `var` can lambda-list (similar to DOLIST+)
+"
+    `(loop :for ,var :on ,list do ,@body ,@(when result? `(:finally (return ,result)))))
+
+
   (defmacro dorange ((var from to &optional (step 1) (result nil result?)) &body body)
     "Binds `var` to all the distinct values in the range [`from`, `to`[, with
 `step` step (note: `to` is excluded), and runs `body` inside that
@@ -681,8 +677,8 @@ PROGN."
        ,@body))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(keep-if keep-if-not aand aif awhen bnd* bnd1 chunked copy-array
-            copy-hash-table digits divf dolist+ dorange dorangei doseq
+  (export '(keep-if keep-if-not aand aif awhen bnd* bnd1 copy-array
+            copy-hash-table digits divf dolist+ dolistl dorange dorangei doseq
             enumerate flatten hash-table-alist hash-table-key-exists-p
             hash-table-keys hash-table-values if-let iota looping make-keyword
             mkstr mulf ncycle repeat string-ends-with-p string-starts-with-p